rsconnect/ 0000755 0001762 0000144 00000000000 14536742742 012266 5 ustar ligges users rsconnect/NAMESPACE 0000644 0001762 0000144 00000003212 14513230050 013456 0 ustar ligges users # Generated by roxygen2: do not edit by hand
S3method(as.data.frame,rsconnect_secret)
S3method(format,rsconnect_secret)
S3method(print,linterResults)
S3method(print,rsconnect_secret)
S3method(str,rsconnect_secret)
export(accountInfo)
export(accountUsage)
export(accounts)
export(addAuthorizedUser)
export(addConnectServer)
export(addLinter)
export(addServer)
export(addServerCertificate)
export(appDependencies)
export(applications)
export(authorizedUsers)
export(configureApp)
export(connectApiUser)
export(connectUser)
export(deployAPI)
export(deployApp)
export(deployDoc)
export(deploySite)
export(deployTFModel)
export(deployments)
export(discoverServers)
export(forgetDeployment)
export(generateAppName)
export(lint)
export(linter)
export(listAccountEnvVars)
export(listBundleFiles)
export(listDeploymentFiles)
export(purgeApp)
export(removeAccount)
export(removeAuthorizedUser)
export(removeServer)
export(resendInvitation)
export(restartApp)
export(rpubsUpload)
export(serverInfo)
export(servers)
export(setAccountInfo)
export(setProperty)
export(showInvited)
export(showLogs)
export(showMetrics)
export(showProperties)
export(showUsage)
export(showUsers)
export(syncAppMetadata)
export(taskLog)
export(tasks)
export(terminateApp)
export(unsetProperty)
export(updateAccountEnvVars)
export(writeManifest)
import(rlang)
importFrom(lifecycle,deprecated)
importFrom(stats,na.omit)
importFrom(stats,setNames)
importFrom(utils,available.packages)
importFrom(utils,contrib.url)
importFrom(utils,getFromNamespace)
importFrom(utils,glob2rx)
importFrom(utils,installed.packages)
importFrom(utils,packageDescription)
importFrom(utils,packageVersion)
importFrom(utils,read.csv)
rsconnect/README.md 0000644 0001762 0000144 00000005421 14536655076 013552 0 ustar ligges users
# rsconnect
[](https://cran.r-project.org/package=rsconnect)
[](https://lifecycle.r-lib.org/articles/stages.html#stable)
[](https://github.com/rstudio/rsconnect/actions)
rsconnect makes it easy to publish your Shiny apps, RMarkdown and Quarto
documents, and Plumber APIs to [Posit
Connect](https://posit.co/products/enterprise/connect/),
[ShinyApps.io](https://www.shinyapps.io/), and [Posit
Cloud](https://posit.cloud/) from R.
(If you’re looking for the Python equivalent, try
[rsconnect-python](https://pypi.org/project/rsconnect-python/).)
## Installation
You can install the released version of rsconnect from
[CRAN](https://CRAN.R-project.org) with:
``` r
install.packages("rsconnect")
```
And the development version from [GitHub](https://github.com/) with:
``` r
# install.packages("devtools")
devtools::install_github("rstudio/rsconnect")
```
## Setup
To use rsconnect, you first need to teach it about the server you want
to publish to. If you use the RStudio IDE, the easiest way to get set up
is to use the publishing dialog, which you can find by clicking the
“Tools” menu, then selecting “Global options”, then clicking
“Publishing”. Click “Connect” to add new servers.
You can also connect from any R session by running a little code:
- For shinyapps.io, go to your [tokens
page](https://www.shinyapps.io/admin/#/tokens) and click “Add Token”,
then follow the instructions to copy and paste the appropriate call to
`setAccountInfo()`. Learn more in the [Getting Started
Guide](https://shiny.rstudio.com/articles/shinyapps.html).
- For Posit Connect, first use `addServer()` to register your server
with rsconnect, then call either `connectUser()` or
`connectApiUser()`. `connectUser()` is a bit simpler if you’re in an
interactive session; `connectApiUser()` works anywhere but requires a
you to copy and paste an API key from your user profile.
- For Posit Cloud, login, then click your name in the top-right corner,
click “Account”, then click “Tokens” in the navbar at the top of the
page. Click “New Token”, then “Copy” next to the token you just
created, and then follow the instructions to copy and paste the
appropriate call to `setAccountInfo()`.
Now that you’re setup you can use `deployApp()`, `deployDoc()`, and
friends to publish your apps, documentations, APIs and more.
rsconnect/man/ 0000755 0001762 0000144 00000000000 14536333553 013035 5 ustar ligges users rsconnect/man/rsconnect-package.Rd 0000644 0001762 0000144 00000002006 14513230050 016670 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/rsconnect-package.R
\docType{package}
\name{rsconnect-package}
\alias{rsconnect}
\alias{rsconnect-package}
\title{rsconnect: Deploy Docs, Apps, and APIs to 'Posit Connect', 'shinyapps.io', and 'RPubs'}
\description{
\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}}
Programmatic deployment interface for 'RPubs', 'shinyapps.io', and 'Posit Connect'. Supported content types include R Markdown documents, Shiny applications, Plumber APIs, plots, and static web content.
}
\seealso{
Useful links:
\itemize{
\item \url{https://github.com/rstudio/rsconnect}
\item Report bugs at \url{https://github.com/rstudio/rsconnect/issues}
}
}
\author{
\strong{Maintainer}: Aron Atkins \email{aron@posit.co}
Authors:
\itemize{
\item Toph Allen
\item Hadley Wickham
\item Jonathan McPherson
\item JJ Allaire
}
Other contributors:
\itemize{
\item Posit Software, PBC [copyright holder, funder]
}
}
\keyword{internal}
rsconnect/man/rsconnectPackages.Rd 0000644 0001762 0000144 00000000425 14513230050 016741 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/rsconnect-package.R
\name{rsconnectPackages}
\alias{rsconnectPackages}
\title{Using Packages with rsconnect}
\description{
See ?\code{\link[=appDependencies]{appDependencies()}}
}
\keyword{internal}
rsconnect/man/applicationConfigDir.Rd 0000644 0001762 0000144 00000000744 14435652570 017422 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/config.R
\name{applicationConfigDir}
\alias{applicationConfigDir}
\title{Application Configuration Directory}
\usage{
applicationConfigDir()
}
\value{
A string containing the path of the configuration folder.
}
\description{
Returns the root path used to store per user configuration data. Does not
check old locations or create the path; use \code{rsconnectConfigDir} for
most cases.
}
\keyword{internal}
rsconnect/man/addConnectServer.Rd 0000644 0001762 0000144 00000001677 14513230050 016547 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/servers-deprec.R
\name{addConnectServer}
\alias{addConnectServer}
\title{Add a server}
\usage{
addConnectServer(url, name = NULL, certificate = NULL, quiet = FALSE)
}
\arguments{
\item{url}{URL for the server. Can be a bare hostname like
\code{connect.mycompany.com} or a url like \verb{http://posit.mycompany.com/connect}.}
\item{name}{Server name. If omitted, the server hostname is used.}
\item{certificate}{Optional. Either a path to certificate file or a
character vector containing the certificate's contents.}
\item{quiet}{Suppress output and prompts where possible.}
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
This function does the same thing as \code{\link[=addServer]{addServer()}} so has been removed.
}
\keyword{internal}
rsconnect/man/purgeApp.Rd 0000644 0001762 0000144 00000001705 14435652570 015113 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/purgeApp.R
\name{purgeApp}
\alias{purgeApp}
\title{Purge an Application}
\usage{
purgeApp(appName, account = NULL, server = NULL, quiet = FALSE)
}
\arguments{
\item{appName}{Name of application to purge}
\item{account}{Account name. If a single account is registered on the system
then this parameter can be omitted.}
\item{server}{Server name. Required only if you use the same account name on
multiple servers (see \code{\link[=servers]{servers()}})}
\item{quiet}{Request that no status information be printed to the console
during the termination.}
}
\description{
Purge a currently archived ShinyApps application.
}
\note{
This function only works for ShinyApps servers.
}
\examples{
\dontrun{
# purge an application
purgeApp("myapp")
}
}
\seealso{
\code{\link[=applications]{applications()}}, \code{\link[=deployApp]{deployApp()}}, and
\code{\link[=restartApp]{restartApp()}}
}
rsconnect/man/addAuthorizedUser.Rd 0000644 0001762 0000144 00000002450 14513230050 016732 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/auth.R
\name{addAuthorizedUser}
\alias{addAuthorizedUser}
\title{Add authorized user to application}
\usage{
addAuthorizedUser(
email,
appDir = getwd(),
appName = NULL,
account = NULL,
server = NULL,
sendEmail = NULL,
emailMessage = NULL
)
}
\arguments{
\item{email}{Email address of user to add.}
\item{appDir}{Directory containing application. Defaults to
current working directory.}
\item{appName}{Name of application.}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
\item{sendEmail}{Send an email letting the user know the application
has been shared with them.}
\item{emailMessage}{Optional character vector of length 1 containing a
custom message to send in email invitation. Defaults to NULL, which
will use default invitation message.}
}
\description{
Add authorized user to application
}
\note{
This function works only for ShinyApps servers.
}
\seealso{
\code{\link[=removeAuthorizedUser]{removeAuthorizedUser()}} and \code{\link[=showUsers]{showUsers()}}
}
rsconnect/man/configureApp.Rd 0000644 0001762 0000144 00000003020 14513230050 015720 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/configureApp.R
\name{configureApp}
\alias{configureApp}
\title{Configure an Application}
\usage{
configureApp(
appName,
appDir = getwd(),
account = NULL,
server = NULL,
redeploy = TRUE,
size = NULL,
instances = NULL,
logLevel = c("normal", "quiet", "verbose")
)
}
\arguments{
\item{appName}{Name of application to configure}
\item{appDir}{Directory containing application. Defaults to
current working directory.}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
\item{redeploy}{Re-deploy application after its been configured.}
\item{size}{Configure application instance size}
\item{instances}{Configure number of application instances}
\item{logLevel}{One of \code{"quiet"}, \code{"normal"} or \code{"verbose"}; indicates how
much logging to the console is to be performed. At \code{"quiet"} reports no
information; at \code{"verbose"}, a full diagnostic log is captured.}
}
\description{
Configure an application running on a remote server.
}
\note{
This function works only for ShinyApps servers.
}
\examples{
\dontrun{
# set instance size for an application
configureApp("myapp", size="xlarge")
}
}
\seealso{
\code{\link[=applications]{applications()}}, \code{\link[=deployApp]{deployApp()}}
}
rsconnect/man/syncAppMetadata.Rd 0000644 0001762 0000144 00000001007 14513230050 016357 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/applications.R
\name{syncAppMetadata}
\alias{syncAppMetadata}
\title{Update deployment records}
\usage{
syncAppMetadata(appPath = ".")
}
\arguments{
\item{appPath}{The path to the directory or file that was deployed.}
}
\description{
Update the deployment records for applications published to Posit Connect.
This updates application title and URL, and deletes records for deployments
where the application has been deleted on the server.
}
rsconnect/man/deployTFModel.Rd 0000644 0001762 0000144 00000001534 14513230050 016015 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deployTFModel.R
\name{deployTFModel}
\alias{deployTFModel}
\title{Deploy a TensorFlow saved model}
\usage{
deployTFModel(modelDir, ...)
}
\arguments{
\item{modelDir}{Path to the saved model directory. Unused.}
\item{...}{Unused.}
}
\description{
This function is defunct. Posit Connect no longer supports hosting of
TensorFlow Model APIs. A TensorFlow model can be deployed as a
\href{https://tensorflow.rstudio.com/guides/deploy/plumber.html}{Plumber API},
\href{https://tensorflow.rstudio.com/guides/deploy/shiny}{Shiny application}, or
other supported content type.
}
\seealso{
Other Deployment functions:
\code{\link{applications}()},
\code{\link{deployAPI}()},
\code{\link{deployApp}()},
\code{\link{deployDoc}()},
\code{\link{deploySite}()}
}
\concept{Deployment functions}
rsconnect/man/generateAppName.Rd 0000644 0001762 0000144 00000002620 14513230050 016337 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/title.R
\name{generateAppName}
\alias{generateAppName}
\title{Generate Application Name}
\usage{
generateAppName(appTitle, appPath = NULL, account = NULL, unique = TRUE)
}
\arguments{
\item{appTitle}{A descriptive title for the application.}
\item{appPath}{The path to the application's content, either a directory
or an individual document. Optional.}
\item{account}{The account where the application will be deployed. Optional.}
\item{unique}{Whether to try to generate a unique name.}
}
\value{
Returns a valid short name for the application.
}
\description{
Generate a short name (identifier) for an application given an application
title.
}
\details{
This function modifies the title until it forms a suitable application name.
Suitable application names are 3 - 64 characters long and contain only
alphanumeric characters.
The function is intended to be used to find a name for a new application.
If \code{appPath} and \code{account} are both specified, then the returned
name will also be unique among locally known deployments of the directory
(note that it is not guaranteed to be unique on the server). This behavior
can be disabled by setting \code{unique = FALSE}.
}
\examples{
\dontrun{
# Generate a short name for a sample application
generateAppName("My Father's Country", "~/fathers-country", "myacct")
}
}
\keyword{internal}
rsconnect/man/servers.Rd 0000644 0001762 0000144 00000001603 14513230050 014774 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/servers.R
\name{servers}
\alias{servers}
\alias{serverInfo}
\title{Server metadata}
\usage{
servers(local = FALSE)
serverInfo(name = NULL)
}
\arguments{
\item{local}{Return only local servers? (i.e. not automatically registered
cloud servers)}
\item{name}{Server name. If omitted, you'll be prompted to pick a server.}
}
\value{
\code{servers()} returns a data frame with registered server names and URLs.
\code{serverInfo()} returns a list with details for a particular server.
}
\description{
\code{servers()} lists all known servers; \code{serverInfo()} gets metadata about
a specific server. Cloud servers \code{shinyapps.io} and \code{posit.cloud} are always
automatically registered and available.
}
\examples{
# List all registered servers
servers()
# Get information about a server
serverInfo("posit.cloud")
}
rsconnect/man/addServer.Rd 0000644 0001762 0000144 00000002674 14513230050 015233 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/servers.R
\name{addServer}
\alias{addServer}
\alias{removeServer}
\alias{addServerCertificate}
\title{Server management}
\usage{
addServer(url, name = NULL, certificate = NULL, validate = TRUE, quiet = FALSE)
removeServer(name = NULL)
addServerCertificate(name, certificate, quiet = FALSE)
}
\arguments{
\item{url}{URL for the server. Can be a bare hostname like
\code{connect.mycompany.com} or a url like \verb{http://posit.mycompany.com/connect}.}
\item{name}{Server name. If omitted, the server hostname is used.}
\item{certificate}{Optional. Either a path to certificate file or a
character vector containing the certificate's contents.}
\item{validate}{Validate that \code{url} actually points to a Posit Connect
server?}
\item{quiet}{Suppress output and prompts where possible.}
}
\description{
These functions manage the list of known servers:
\itemize{
\item \code{addServer()} registers a Posit connect server. Once it has been
registered, you can connect to an account on the server using
\code{\link[=connectUser]{connectUser()}}.
\item \code{removeServer()} removes a server from the registry.
\item \code{addServerCertificate()} adds a certificate to a server.
}
}
\examples{
\dontrun{
# register a local server
addServer("http://myrsconnect/", "myserver")
# list servers
servers(local = TRUE)
# connect to an account on the server
connectUser(server = "myserver")
}
}
rsconnect/man/showInvited.Rd 0000644 0001762 0000144 00000001627 14513230050 015614 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/auth.R
\name{showInvited}
\alias{showInvited}
\title{List invited users for an application}
\usage{
showInvited(appDir = getwd(), appName = NULL, account = NULL, server = NULL)
}
\arguments{
\item{appDir}{Directory containing application. Defaults to
current working directory.}
\item{appName}{Name of application.}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
}
\description{
List invited users for an application
}
\note{
This function works only for ShinyApps servers.
}
\seealso{
\code{\link[=addAuthorizedUser]{addAuthorizedUser()}} and \code{\link[=showUsers]{showUsers()}}
}
rsconnect/man/removeAuthorizedUser.Rd 0000644 0001762 0000144 00000002014 14513230050 017473 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/auth.R
\name{removeAuthorizedUser}
\alias{removeAuthorizedUser}
\title{Remove authorized user from an application}
\usage{
removeAuthorizedUser(
user,
appDir = getwd(),
appName = NULL,
account = NULL,
server = NULL
)
}
\arguments{
\item{user}{The user to remove. Can be id or email address.}
\item{appDir}{Directory containing application. Defaults to
current working directory.}
\item{appName}{Name of application.}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
}
\description{
Remove authorized user from an application
}
\note{
This function works only for ShinyApps servers.
}
\seealso{
\code{\link[=addAuthorizedUser]{addAuthorizedUser()}} and \code{\link[=showUsers]{showUsers()}}
}
rsconnect/man/unsetProperty.Rd 0000644 0001762 0000144 00000002155 14513230050 016211 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/configureApp.R
\name{unsetProperty}
\alias{unsetProperty}
\title{Unset Application property}
\usage{
unsetProperty(
propertyName,
appPath = getwd(),
appName = NULL,
account = NULL,
server = NULL,
force = FALSE
)
}
\arguments{
\item{propertyName}{Name of property}
\item{appPath}{Directory or file that was deployed. Defaults to current
working directory.}
\item{appName}{Name of application}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
\item{force}{Forcibly unset the property}
}
\description{
Unset a property on currently deployed ShinyApps application (restoring to
its default value)
}
\note{
This function only works for ShinyApps servers.
}
\examples{
\dontrun{
# unset application package cache property to revert to default
unsetProperty("application.package.cache")
}
}
rsconnect/man/discoverServers.Rd 0000644 0001762 0000144 00000000751 14513230050 016476 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/servers-deprec.R
\name{discoverServers}
\alias{discoverServers}
\title{Discover servers automatically}
\usage{
discoverServers(quiet = FALSE)
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
This function has never worked usefully, so has been removed.
}
\keyword{internal}
rsconnect/man/deployAPI.Rd 0000644 0001762 0000144 00000002021 14435652570 015146 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deployAPI.R
\name{deployAPI}
\alias{deployAPI}
\title{Deploy a Plumber API}
\usage{
deployAPI(api, ...)
}
\arguments{
\item{api}{Path to the API project directory. Must contain either
\code{entrypoint.R} or \code{plumber.R}}
\item{...}{Additional arguments to \code{\link[=deployApp]{deployApp()}}.}
}
\description{
Deploys an application consisting of plumber API routes. The given directory
must contain a script returning a \code{plumb} object or a plumber API definition.
}
\details{
Deploy a plumber API definition by either supplying a directory
containing \code{plumber.R} (an API definition) or \code{entrypoint.R} that returns a
\code{plumb} object created by \code{plumber::plumb()}. See the plumber documentation
for more information.
}
\seealso{
Other Deployment functions:
\code{\link{applications}()},
\code{\link{deployApp}()},
\code{\link{deployDoc}()},
\code{\link{deploySite}()},
\code{\link{deployTFModel}()}
}
\concept{Deployment functions}
rsconnect/man/rsconnectConfigDir.Rd 0000644 0001762 0000144 00000001002 14435652570 017101 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/config.R
\name{rsconnectConfigDir}
\alias{rsconnectConfigDir}
\title{rsconnect Configuration Directory}
\usage{
rsconnectConfigDir(subDir = NULL)
}
\arguments{
\item{subDir}{An optional subdirectory to be included as the last element of
the path.}
}
\value{
The path to the configuration directory.
}
\description{
Forms the path to a location on disk where user-level configuration data for
the package is stored.
}
\keyword{internal}
rsconnect/man/setProperty.Rd 0000644 0001762 0000144 00000002267 14513230050 015652 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/configureApp.R
\name{setProperty}
\alias{setProperty}
\title{Set Application property}
\usage{
setProperty(
propertyName,
propertyValue,
appPath = getwd(),
appName = NULL,
account = NULL,
server = NULL,
force = FALSE
)
}
\arguments{
\item{propertyName}{Name of property}
\item{propertyValue}{Property value}
\item{appPath}{Directory or file that was deployed. Defaults to current
working directory.}
\item{appName}{Name of application}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
\item{force}{Forcibly set the property}
}
\description{
Set a property on currently deployed ShinyApps application.
}
\note{
This function only works for ShinyApps servers.
}
\examples{
\dontrun{
# set instance size for an application
setProperty("application.instances.count", 1)
# disable application package cache
setProperty("application.package.cache", FALSE)
}
}
rsconnect/man/listAccountEnvVars.Rd 0000644 0001762 0000144 00000003003 14513230050 017074 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/envvars.R
\name{listAccountEnvVars}
\alias{listAccountEnvVars}
\alias{updateAccountEnvVars}
\title{Maintain environment variables across multiple applications}
\usage{
listAccountEnvVars(server = NULL, account = NULL)
updateAccountEnvVars(envVars, server = NULL, account = NULL)
}
\arguments{
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
\item{envVars}{Names of environment variables to update. Their
values will be automatically retrieved from the current process.
If you specify multiple environment variables, any application that
uses any of them will be updated with all of them.}
}
\value{
\code{listAccountEnvVars()} returns a data frame with one row
for each data frame. It has variables \code{id}, \code{guid}, \code{name}, and
\code{envVars}. \code{envVars} is a list-column.
}
\description{
\itemize{
\item \code{listAccountEnvVars()} lists the environment variables used by
every application published to the specified account.
\item \code{updateAccountEnvVars()} updates the specified environment variables with
their current values for every app that uses them.
}
Secure environment variable are currently only supported by Posit Connect
so other server types will generate an error.
}
rsconnect/man/applications.Rd 0000644 0001762 0000144 00000003601 14513230050 015771 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/applications.R
\name{applications}
\alias{applications}
\title{List Deployed Applications}
\usage{
applications(account = NULL, server = NULL)
}
\arguments{
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
}
\value{
Returns a data frame with the following columns:
\tabular{ll}{
\code{id} \tab Application unique id \cr
\code{name} \tab Name of application \cr
\code{title} \tab Application title \cr
\code{url} \tab URL where application can be accessed \cr
\code{status} \tab Current status of application. Valid values are \code{pending},
\code{deploying}, \code{running}, \code{terminating}, and \code{terminated} \cr
\code{size} \tab Instance size (small, medium, large, etc.) (on
ShinyApps.io) \cr
\code{instances} \tab Number of instances (on ShinyApps.io) \cr
\code{config_url} \tab URL where application can be configured \cr
}
}
\description{
List all applications currently deployed for a given account.
}
\note{
To register an account you call the \code{\link[=setAccountInfo]{setAccountInfo()}} function.
}
\examples{
\dontrun{
# list all applications for the default account
applications()
# list all applications for a specific account
applications("myaccount")
# view the list of applications in the data viewer
View(applications())
}
}
\seealso{
\code{\link[=deployApp]{deployApp()}}, \code{\link[=terminateApp]{terminateApp()}}
Other Deployment functions:
\code{\link{deployAPI}()},
\code{\link{deployApp}()},
\code{\link{deployDoc}()},
\code{\link{deploySite}()},
\code{\link{deployTFModel}()}
}
\concept{Deployment functions}
rsconnect/man/addLinter.Rd 0000644 0001762 0000144 00000003216 14513230050 015213 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lint-framework.R, R/linters.R
\name{addLinter}
\alias{addLinter}
\title{Add a Linter}
\usage{
addLinter(name, linter)
addLinter(name, linter)
}
\arguments{
\item{name}{The name of the linter, as a string.}
\item{linter}{A \code{\link[=linter]{linter()}}.}
}
\description{
Add a linter, to be used in subsequent calls to \code{\link[=lint]{lint()}}.
Add a linter, to be used in subsequent calls to \code{\link[=lint]{lint()}}.
}
\examples{
addLinter("no.capitals", linter(
## Identify lines containing capital letters -- either by name or by index
apply = function(content, ...) {
grep("[A-Z]", content)
},
## Only use this linter on R files (paths ending with .r or .R)
takes = function(paths) {
grep("[rR]$", paths)
},
# Use the default message constructor
message = function(content, lines, ...) {
makeLinterMessage("Capital letters found on the following lines", content, lines)
},
# Give a suggested prescription
suggest = "Do not use capital letters in these documents."
))
addLinter("no.capitals", linter(
## Identify lines containing capital letters -- either by name or by index
apply = function(content, ...) {
grep("[A-Z]", content)
},
## Only use this linter on R files (paths ending with .r or .R)
takes = function(paths) {
grep("[rR]$", paths)
},
# Use the default message constructor
message = function(content, lines, ...) {
makeLinterMessage("Capital letters found on the following lines", content, lines)
},
# Give a suggested prescription
suggest = "Do not use capital letters in these documents."
))
}
rsconnect/man/lint.Rd 0000644 0001762 0000144 00000001220 14513230050 014244 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lint.R
\name{lint}
\alias{lint}
\title{Lint a Project}
\usage{
lint(project, files = NULL, appPrimaryDoc = NULL)
}
\arguments{
\item{project}{Path to a project directory.}
\item{files}{Specific files to lint. Can be NULL, in which case all
the files in the directory will be linted.}
\item{appPrimaryDoc}{The primary file in the project directory. Can be NULL,
in which case it's inferred (if possible) from the directory contents.}
}
\description{
Takes the set of active linters (see \code{\link[=addLinter]{addLinter()}}), and applies
them to all files within a project.
}
rsconnect/man/showUsage.Rd 0000644 0001762 0000144 00000002451 14513230050 015252 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/usage.R
\name{showUsage}
\alias{showUsage}
\title{Show Application Usage}
\usage{
showUsage(
appDir = getwd(),
appName = NULL,
account = NULL,
server = NULL,
usageType = "hours",
from = NULL,
until = NULL,
interval = NULL
)
}
\arguments{
\item{appDir}{Directory containing application. Defaults to
current working directory.}
\item{appName}{Name of application}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
\item{usageType}{Use metric to retreive (for example: "hours")}
\item{from}{Date range starting timestamp (Unix timestamp or relative time
delta such as "2d" or "3w").}
\item{until}{Date range ending timestamp (Unix timestamp or relative time
delta such as "2d" or "3w").}
\item{interval}{Summarization interval. Data points at intervals less then this
will be grouped. (Relative time delta e.g. "120s" or "1h" or "30d").}
}
\description{
Show application usage of a currently deployed application
}
\note{
This function only works for ShinyApps servers.
}
rsconnect/man/connectApiUser.Rd 0000644 0001762 0000144 00000002770 14513230050 016233 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/accounts.R
\name{connectApiUser}
\alias{connectApiUser}
\alias{connectUser}
\title{Register account on Posit Connect}
\usage{
connectApiUser(account = NULL, server = NULL, apiKey, quiet = FALSE)
connectUser(
account = NULL,
server = NULL,
quiet = FALSE,
launch.browser = getOption("rsconnect.launch.browser", interactive())
)
}
\arguments{
\item{account}{A name for the account to connect.}
\item{server}{The server to connect to.}
\item{apiKey}{The API key used to authenticate the user}
\item{quiet}{Whether or not to show messages and prompts while connecting the
account.}
\item{launch.browser}{If true, the system's default web browser will be
launched automatically after the app is started. Defaults to \code{TRUE} in
interactive sessions only. If a function is passed, it will be called
after the app is started, with the app URL as a parameter.}
}
\description{
\code{connectUser()} and \code{connectApiUser()} connect your Posit Connect account to
the rsconnect package so that it can deploy and manage applications on
your behalf.
\code{connectUser()} is the easiest place to start because it allows you to
authenticate in-browser to your Posit Connect server. \code{connectApiUser()} is
appropriate for non-interactive settings; you'll need to copy-and-paste the
API key from your account settings.
}
\seealso{
Other Account functions:
\code{\link{accounts}()},
\code{\link{setAccountInfo}()}
}
\concept{Account functions}
rsconnect/man/deployDoc.Rd 0000644 0001762 0000144 00000003350 14513230050 015226 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deployDoc.R
\name{deployDoc}
\alias{deployDoc}
\title{Deploy a single document}
\usage{
deployDoc(doc, ..., logLevel = c("normal", "quiet", "verbose"))
}
\arguments{
\item{doc}{Path to the document to deploy.}
\item{...}{Additional arguments to \code{\link[=deployApp]{deployApp()}}. Do not supply \code{appDir},
\code{appFiles}, or \code{appPrimaryDoc}; these three parameters are automatically
generated by \code{deployDoc} from the document.}
\item{logLevel}{One of \code{"quiet"}, \code{"normal"} or \code{"verbose"}; indicates how
much logging to the console is to be performed. At \code{"quiet"} reports no
information; at \code{"verbose"}, a full diagnostic log is captured.}
}
\description{
Deploys a single R Markdown, Quarto document, or other file (e.g. \code{.html} or
\code{.pdf}).
When deploying an \code{.Rmd}, \code{.Qmd}, or \code{.html}, \code{deployDoc()} will attempt to
automatically discover dependencies using \code{\link[rmarkdown:find_external_resources]{rmarkdown::find_external_resources()}},
and include an \code{.Rprofile} if present. If you find that the document is
missing dependencies, either specify the dependencies explicitly in the
document (see \code{\link[rmarkdown:find_external_resources]{rmarkdown::find_external_resources()}} for details), or call
\code{\link[=deployApp]{deployApp()}} directly and specify your own file list in \code{appFiles}.
}
\examples{
\dontrun{
deployDoc("my-report.Rmd")
deployDoc("static-file.html")
}
}
\seealso{
Other Deployment functions:
\code{\link{applications}()},
\code{\link{deployAPI}()},
\code{\link{deployApp}()},
\code{\link{deploySite}()},
\code{\link{deployTFModel}()}
}
\concept{Deployment functions}
rsconnect/man/tasks.Rd 0000644 0001762 0000144 00000001621 14513230050 014430 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/tasks.R
\name{tasks}
\alias{tasks}
\title{List Tasks}
\usage{
tasks(account = NULL, server = NULL)
}
\arguments{
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
}
\value{
Returns a data frame with the following columns:
\tabular{ll}{
\code{id} \tab Task id \cr
\code{action} \tab Task action\cr
\code{status} \tab Current task status\cr
\code{created_time} \tab Task creation time\cr
\code{finished_time} \tab Task finished time\cr
}
}
\description{
List Tasks
}
\examples{
\dontrun{
# list tasks for the default account
tasks()
}
}
\seealso{
\code{\link[=taskLog]{taskLog()}}
}
rsconnect/man/writeManifest.Rd 0000644 0001762 0000144 00000011721 14513230050 016126 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/writeManifest.R
\name{writeManifest}
\alias{writeManifest}
\title{Create a \code{manifest.json}}
\usage{
writeManifest(
appDir = getwd(),
appFiles = NULL,
appFileManifest = NULL,
appPrimaryDoc = NULL,
appMode = NULL,
contentCategory = NULL,
python = NULL,
forceGeneratePythonEnvironment = FALSE,
quarto = NA,
image = NULL,
envManagement = NULL,
envManagementR = NULL,
envManagementPy = NULL,
verbose = FALSE,
quiet = FALSE
)
}
\arguments{
\item{appDir}{A directory containing an application (e.g. a Shiny app
or plumber API). Defaults to the current directory.}
\item{appFiles, appFileManifest}{Use \code{appFiles} to specify a
character vector of files to bundle in the app or \code{appManifestFiles}
to provide a path to a file containing a list of such files. If neither
are supplied, will bundle all files in \code{appDir}, apart from standard
exclusions and files listed in a \code{.rscignore} file. See
\code{\link[=listDeploymentFiles]{listDeploymentFiles()}} for more details.}
\item{appPrimaryDoc}{If the application contains more than one document, this
parameter indicates the primary one, as a path relative to \code{appDir}. Can be
\code{NULL}, in which case the primary document is inferred from the contents
being deployed.}
\item{appMode}{Optional; the type of content being deployed.
Provide this option when the inferred type of content is incorrect. This
can happen, for example, when static HTML content includes a downloadable
Shiny application \code{app.R}. Accepted values include \code{"shiny"}, \code{"api"},
\code{"rmd-static"}, \code{"rmd-shiny"}, \code{"quarto-static"}, \code{"quarto-shiny"}, and
\code{"static"}. The Posit Connect API Reference contains a full set of
available values. Not all servers support all types of content.}
\item{contentCategory}{Set this to \code{"site"} if you'd deploy with
\code{\link[=deploySite]{deploySite()}}; otherwise leave as is.}
\item{python}{Full path to a python binary for use by \code{reticulate}.
Required if \code{reticulate} is a dependency of the app being deployed.
If python = NULL, and RETICULATE_PYTHON or RETICULATE_PYTHON_FALLBACK is
set in the environment, its value will be used. The specified python binary
will be invoked to determine its version and to list the python packages
installed in the environment.}
\item{forceGeneratePythonEnvironment}{Optional. If an existing
\code{requirements.txt} file is found, it will be overwritten when this argument
is \code{TRUE}.}
\item{quarto}{Should the deployed content be built by quarto?
(\code{TRUE}, \code{FALSE}, or \code{NA}). The default, \code{NA}, will use quarto if
there are \code{.qmd} files in the bundle, or if there is a
\verb{_quarto.yml} and \code{.Rmd} files.
(This option is ignored and quarto will always be used if the
\code{metadata} contains \code{quarto_version} and \code{quarto_engines} fields.)}
\item{image}{Optional. The name of the image to use when building and
executing this content. If none is provided, Posit Connect will
attempt to choose an image based on the content requirements.}
\item{envManagement}{Optional. Should Posit Connect install R and Python
packages for this content? (\code{TRUE}, \code{FALSE}, or \code{NULL}).
The default, \code{NULL}, will not write any values to the bundle manifest,
and Connect will fall back to the application default environment
management strategy, or the server default if no application default
is defined.
(This option is a shorthand flag which overwrites the values of both
\code{envManagementR} and \code{envManagementPy}.)}
\item{envManagementR}{Optional. Should Posit Connect install R packages
for this content? (\code{TRUE}, \code{FALSE}, or \code{NULL}). The default, \code{NULL}, will
not write any values to the bundle manifest, and Connect will fall back to
the application default R environment management strategy, or the server
default if no application default is defined.
(This option is ignored when \code{envManagement} is non-\code{NULL}.)}
\item{envManagementPy}{Optional. Should Posit Connect install Python packages
for this content? (\code{TRUE}, \code{FALSE}, or \code{NULL}). The default, \code{NULL}, will
not write any values to the bundle manifest, and Connect will fall back to
the application default Python environment management strategy, or the
server default if no application default is defined.
(This option is ignored when \code{envManagement} is non-\code{NULL}.)}
\item{verbose}{If \code{TRUE}, prints detailed progress messages.}
\item{quiet}{If \code{FALSE}, prints progress messages.}
}
\description{
Use \code{writeManifest()} to generate a \code{manifest.json}. Among other things,
you can commit this file to git to activate
\href{https://docs.posit.co/connect/user/git-backed/}{Git-Backed content}
for Posit Connect.
\code{manifest.json} contains a list of all files in the app along with their
dependencies, so you will need to re-run \code{writeManifest()} when either of
these change.
}
rsconnect/man/taskLog.Rd 0000644 0001762 0000144 00000001536 14513230050 014714 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/tasks.R
\name{taskLog}
\alias{taskLog}
\title{Show task log}
\usage{
taskLog(taskId, account = NULL, server = NULL, output = NULL)
}
\arguments{
\item{taskId}{Task Id}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
\item{output}{Where to write output. Valid values are \code{NULL} or \code{stderr}}
}
\description{
Writes the task log for the given task
}
\examples{
\dontrun{
# write task log to stdout
taskLog(12345)
# write task log to stderr
taskLog(12345, output="stderr")
}
}
\seealso{
\code{\link[=tasks]{tasks()}}
}
rsconnect/man/linter.Rd 0000644 0001762 0000144 00000004050 14513230050 014577 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lint-framework.R, R/linters.R
\name{linter}
\alias{linter}
\title{Create a Linter}
\usage{
linter(apply, takes, message, suggestion)
linter(apply, takes, message, suggestion)
}
\arguments{
\item{apply}{Function that, given the content of a file, returns the indices
at which problems were found.}
\item{takes}{Function that, given a set of paths, returns the subset of
paths that this linter uses.}
\item{message}{Function that, given content and lines, returns an
informative message for the user. Typically generated with
\code{\link[=makeLinterMessage]{makeLinterMessage()}}.}
\item{suggestion}{String giving a prescribed fix for the linted problem.}
}
\description{
Generate a linter, which can identify errors or problematic regions in a
project.
Generate a linter, which can identify errors or problematic regions in a
project.
}
\examples{
addLinter("no.capitals", linter(
## Identify lines containing capital letters -- either by name or by index
apply = function(content, ...) {
grep("[A-Z]", content)
},
## Only use this linter on R files (paths ending with .r or .R)
takes = function(paths) {
grep("[rR]$", paths)
},
# Use the default message constructor
message = function(content, lines, ...) {
makeLinterMessage("Capital letters found on the following lines", content, lines)
},
# Give a suggested prescription
suggest = "Do not use capital letters in these documents."
))
addLinter("no.capitals", linter(
## Identify lines containing capital letters -- either by name or by index
apply = function(content, ...) {
grep("[A-Z]", content)
},
## Only use this linter on R files (paths ending with .r or .R)
takes = function(paths) {
grep("[rR]$", paths)
},
# Use the default message constructor
message = function(content, lines, ...) {
makeLinterMessage("Capital letters found on the following lines", content, lines)
},
# Give a suggested prescription
suggest = "Do not use capital letters in these documents."
))
}
rsconnect/man/figures/ 0000755 0001762 0000144 00000000000 14513230050 014460 5 ustar ligges users rsconnect/man/figures/lifecycle-defunct.svg 0000644 0001762 0000144 00000002424 14513230050 020570 0 ustar ligges users
rsconnect/man/figures/lifecycle-maturing.svg 0000644 0001762 0000144 00000002430 14513230050 020763 0 ustar ligges users
rsconnect/man/figures/logo.png 0000644 0001762 0000144 00000057463 14435652570 016167 0 ustar ligges users PNG
IHDR ! gAMA a cHRM z& u0 ` : pQ< bKGD pHYs + tIME) ]IDATxwxTU;-d+ %$!( ])X(
ˮUW/O]{(.VtB 4! ԙL/ɼg ;ܙ= }իWs%,qw|βf U`u"&K B5y߁7ZdfY7"c# GTU`/!|hOni >L+Y7 X{?~1L}%Lv{U46R+,?ۺ밻AL6M:_!CZեeXSf Ø?t7_ᛍjm)^Y={}|ļ%k H=6e< |%JR7^AრZyA͇ 7̞1 =6$, = RFekp fW^3 M~HS s?~sŖ VX_90O.`/d(s`AƔXSm
ǯ7yeAlyWGOB7n7A`ĪrT*+8~TxyÏV;>,L"zyz%n ^Ւ%]ONF{! 8xRxRwW~ہ
Ui᧴`ӎ
|XOY>o@ 8$22SX,vw=M| [ 4~^- gt>!;[@t\ }~5c]
4c+/")gP@P̺m;z5|Bv '1nRa1c/c}vI,^8@_GEzr nĒ{7@uBU[},!8,ooOv|5g(ȚG/ R??wWnAg）;~:ܓ @ɗC3ZzuV|BG >
Je2,!L=p:g_Ec}-_XOq&|B W > \m/k쒮'd^jj5.\J BBBB0l0}~{풄
+NO]^xa
]
hhhc H @j1b YƧk߂gt(>!Bgg rp\hRAP__I&! jӖIlKR] >!{!\g/t/^Dyy9̬gjH$7Ρ܈w_{Y.ى~-dy)cƺv~b0sL0 }iM [߶ry,R+,kub6p o[ouoP(ϙB6 X;P)[m9_%ϟϢ 8J).d];`ձ.o|ǼY(Zo m%%%fT*0f범l Gz5v\.ﱧ<pB*:&n|vIB^9n_kt[,bE^m/J)Μ9R, T
e!T*j5ֲ쒽p^BB eĘ>c/4VǡP( Ap%BRA,#22
9{ )>ްu׃ |{}J+Ϻ ۗ]immEVV
@u;Ux_%AHJR,] ͺp ѣ],|`Di/r]GB6 CZ!wǏwSWv:hu.B^`S %k
!)xU
.\:A$n. @G ě^'`셁 <* 8qb1Fet6U]kgG@LgP"6/ڋJBVV1x`wǥkdtg[ww=,l +텄0H˘?=ľHcc#N8dDFF8n
cMVmvI%@x B{(//G^^ ] c]PЗ69#b[iG` ܹ %/]0g JI.ã]8WUxmC>>J
!XxM&XJ ز{OB.cMqx;f--ݍ=vIR0OqZwmBIb-?V ~n{au{ 6VG1 BG'`P.(m[[ )܊aKlI|P[]eq\/U~ 셔CC !X:'7MZwI "b*|c t
C ???֤'>r ~f 9̎ܮ|{96tzcbHX/hT*!ɠP(%.IQGcv ^{-+VbfWVV . 88Æ
GkV5% BBuQhz^Ubn&a _Kl
ZMMMF666yt
CO ܻy{\nv] !3|6{!AZFUBJ)JJJPPP( :䱕u؋ꆞkoR#M7WLjq쓩#pB)Ess3mnnqF*
Ǟ.i>[@S\\˗/#>> B3 >gz. Y`ju%ƥ, K^ahU*q kn@@ۖ v3Y{i 偸`lD\4V"!11qqq m%x൳&q,0=[M@1^-brǫ%_Z,/v\ES~~= (O^$C;>߶kUGYŋ'Hl.e ݾ)MѠ UUU ?&5w\ b 9ZըR@X}E"R~ ~,,8(&˝W;\wep']w@N@555RԦ (Oc߮ XZTJ[. {t<\gR/ W>p}F8(, DTXZzt Ee* _e l{x?/? tjhhV4u'*I!{j4x7&18 w D)v +A 8}kL (EۃTuF x 'M@yζKv?ʪns_]
G/ C0Pˀ
aAb,E~,uʪ[PӠRF+ P U>~;^w!"0 PR< Z8r 5
~<ޘ&:֝Pƫ B[Qk/څ˻.c)$ T :4xHѷwu*0,0m`-q y ǧp<!x}ؤű`QpJ 1r6Lw5d*((b!?5Y4d `O } mG_ V O+1\m<2` 0Ha@AkaV P o !~ πc2շZ?fȧM@!11M@y
b<4nZo\TdϺ-8 V-NJR,~L3[dE з 0 %5$`(Ӧ]° . ,ϊ VeA~T0Ȼھ 11hT` @?}3n6p @"&`@ ,FL@ (O!2:/vV:%%a0},AR >S_5GGs V/fZAD,ae
Qx0` e@bR@:`DS
-/ai֢^wj a@@"@?0-* .W( )%PѾ (dtxߺOw_,>! IN w -=Dֵ2+uZEZf{V @G N1t)@ATQj-f5ɠ(Z4 [_Zb{*:#TXX ⛀2nn,eI]Ef c;$n&9r G:c6e cdekȷmᚄ - 3F'D8UX 54Z
C VDɺLݹ|7GKxU().xU旫
y=Z Ue5mk}YbA,&l%h8qMPbF[XT?MdXvmA(Kp,B" ^i4K m!33ݗ߇Ky7݂ O[kL
.`p;(`cl^G 7O 1-&EB =*`E Á7;MEږP*"䂫֧kwj!V`jٵ]շƝEܽe?=fyNj HN2b "ho;R*N] @{6wxMV vka|vQי9'N.?k͇/_D_sfĠ`A);Llu1H*;v)q7H >W݈OE0LVDuxeB&F7E⓽ؒUÁAAD@^- YQ `ZНבKUF11q?D~ _ԯX[8
R Ń3$,81AL.~B7
N-CCÁx 2wf,D2 ~2! $ k^ cYF
3cz cB ֏Y"hǫ &5"; n!,11no "Dbb??bxH{R0,\f(X]y̓5w(;CٚG īf KʡBk n(Ctvk6SX`,8 ÀRGpk19!,C C `臶T?m[ Ah,C_kn+E C0(F A|!v<es-Z5@!!
=Qp0M0JKAH0(> cFዷ Qv*Jق rZ
9!"9 AEP9]4X ; #z3F`n-rzY/d %`6~1`X!<HR
<9) 18vg qnkq
I]oL!Xx0L)9˗qM
p""0 ӀP
Z8 F#"* CGyT+B5!
k>/CU3=d", LX%z #,a)V`I 2AĔ< F"/:ݨ.MSH$BHHBB-%AO#St U1 A"b$"iXĺ.S9^i!#P )mkX* %
CDε kK/( #%Hwm,V_0iD^ ! -BtkГ;{e466qǕ \ rE/ZT`t'iz! `|ۏؚ(1m(9gt&):,VJ`"Tj(N5jz!"P*@ɩR<>1 `DZZ ʛtB#:rw>PvC]au8_lg#C,v5HEqf*b)n x](i!r9ܢN mEN
! XAHUK{mc=KlnBmck/~Y>'!;/7Hحw(=(hQ"qu['<55,j[hp
/vP2!zh:1E[SZaYK9p A"Gڻ؝Twh;|`o/ (ABو%nhh ɟ+Qw$Ƌ~r Dno2C 1r)cDOqVb
P t%"'8`k /Wis3L XV.@V
J}6NwB{,cכcp}aSniiASSQPP` nwڊ1Q ם6G
GF:2aaml}B %hZqP:^Ё!<CMn"Fo$DR1D~b}\ mKPѪBIZ' H؞g1oR/5
0`
nS01Q2 !1rf\, ? Wj|vr{aL,ܶ~,`sbXB8ZЖW`X0P*atB 0BLg'sz"6ֈۑ[ւoQ #Tw%a``~v2 @@A CA2 i+A,W3& g[V2MBZ!Gjjjf -O fa .N5B[,t{L 跮 mim۷G
AG!\Ԃ 5xSѿЋЗHw&yRqN ]v䌻h>! 3 Ai VE0l:N~]B[Z-I[
"60%h;=:Th{ĉ k-ɠnhc㮄rWqڥ''aq?NAk!́P
"軽þL uhc/v:Xm ]EYɀ
֗ֈ9q =
'Xh@
Ns%&%. ?$øV*̼V0>t5B
^U@y;}n@{R O???pK `;^>+d vD^cK,]4I)ĔA\m7O&H IZ_]LJXAv3;47.'aD ;F 9oh#4>Ov;QP4 Տ^^Xn4Ӿ_11)m mǴ:3 D
xޡKU<oCl-2 #ѿ7vvR=wl_C۱tn
]kAK!h;(jA?g]j,-ruu5Dǃ Jܡ&(ַ .-5iZ㺮aH0v;v㘙经"%[wDoLl"ZA_t sDЇ[z9s&L03ᇿżQ[.YߝZY]xXgbKgz\xwf(ã|"H <'V>OMMM8y$Ə O*b ð8e-
۷oi1t ~RCpHE
%X}P vWimm!J*4,*Re焬T*TM OKj4iۻ҆ .}Z0najCH%miWL)QXg.]NC}}=PSSJ)$@Դb[ȇ!0PSBh48vFB{Yۣp-] ZckLYFi!̲-?6噑;: 렔ըJBHH1tPp z\ȺppDO6pQ$%%u2[#-3
eF\i+9ZE-W3 mQ\Đs0!i5 a! @b4>
ajZ[[mllD`` 1f̘nC&
CJZRf
B]TBy G eaM:
]CNI#.iQLѢm "PL ``1iH0\5
*QQ\ RNB$ Pg~5552q Cbb"-*o(8 ).ԡT.)8~8 X?o ,OV"vV4Vk (8e]T*Exx8 bф-DDD",E50=J.Q1$%r^^ 4
Ǝ K9y ~Z"V Pv ?|l fζUBuu5t: BCC#G,)݈p@=:İΝn#pD_^k(..F}}=ݳUlgЀYFDl@X]q\"Yˉnf.vz4 σ bsN:>g?i
xKKKQZZ yilQΚ =XV2,q}Z6555dN.ۂH$B53p0M8@`
+%QD`i.c0W p|&g['x>S"1oXkp5נ @}}B\B)E"T@Q!Kq%L8#a)е60*}D nnZ?9nڶ1#P__g ÇKL)у@r W.B?Lk$!B0au8 XZKD]pO 'MFxDDR 8p HHH^S%
**ȃ\y ø=3#^NVIBb >II>eA^^ w 8pjFM"6LB0` DFF 8p F wWG\"ʫ0@6' ""#>zTUUlxT:p(A'y fwH$#Ѐ3g K B{ײDQO2oE#""UBVeYD"dgg#r@"Bu=0E
~0C}
ƓBR1B@C
펳uuuf%B 2l.kQ'R HJk`5$+dQ'OBѸztIf"t.ׂ
2?fɢi
=_ff&\bp$ Ǝ鹼<>}k"":7ȑ#섄>zƭʰa<} r ?=zhcw[V Zƞ={j*l߾ݡv{v8t}_ވaI ۇ ˗/Ǿ}g
tȐ! 8 ? G <&)(^T(t] 1bǥmr&ӧOG^^K>#fld2F ,t:ODyڀf- 3f Ο?߯ۅ.,2 >> 'Oh ]_D"Zvu Dff&p!Ux !!.\pwQL 8o«7 kZCuu/E #GDmm-^
hjjBee%Jqtƽ{z}5BVT-W܅VEuu5ٽt6 b:--
8vU/}_ hhhv =& KFɸ Jׯ?"<ѣGcƍ= h{nl߾ իW;]8L 6 iiiHMMŔ)S,^{qAu1#11[ 2 ۷oǡCpauqJ$DEEa k0w\}ڄ 0sL ;i&|1?W^y.]躎5
1qD ((([oު ח^z wy' 33rرcm۶nqb1姆,Y '4
}QlٲEAuu5 z! 8 ;9{,>غu+>c3VVVb (--:/"nddd܂544`ѢE<^{
R<@
X9sشiktir-xp-XțMsylSE"^xi".**ܹs &b}o>,X;0 \xٳg*ӟ'DܑM6\~A裏ZkLW_Zt: x V^'|ҫE 8Aȵ,z'aÆ^'6744;ﴺ<ʕ+Xrþ&}6n VOOعsǩT^?pQB R<(//7? ~M4 m|֑/k>,.\p :tqqq(++uVTO=EḸ83h4tN8aRnicc` hllđ#G\UVaڵvIII?~<Acz۷o7>311ј@1;;ۼBWlقdy֭[g1pϋ\-O({o .w{ĉXfMH$7n Q[['N8 (;%mnU@&ukm˩!;w. ZN'tO?4V\i{ܸq8rӑ k-S?-[jj*VZn555aӦMO{n\xyR)^~e,^Slܸ/%-[ 6k ,_IJeˌ+70y\qq1T*R7n#^}g7>?]r555v-cpS;]טpESQ]V/O=ry_}UwOH$<뮻zرcs] &UVaV_sS8M3g[om-]UU㻮A8 ?Lp g\rʛoi6jhyXv1kFWr9>,^kz {a֬Yݞg˗/˲_㱂 ?/l~'0O>ȑ#&? > x#k.^pی}p̙ \ĜHy3---8rHJvv6~weW_}TIOOƍ=&S&
> 5H[ꫯ: 2$$6)TJ={t :Zà cX[0wnTjv%P0iކ =
q:bK,xoB&UīwכU
:ԒSz Xc g }Ə og\z?0mۆ'N@R_3'3bn9
;\sL1湷rgeMq6%co7[ˍ7ѣ6~YZf.&Nopu:H&WeS5gd _>{|
6nhqO>gFNNƎ kGPWWzg LTn,^C)]G& .v!܌hZjc6PDbqaM1o#l@,oߎ|wؼyxfPQQى A{ntM6 W'OԩS{= 9T_YBɱyI&ٵTPPbo{mV}JR˲m#33kz6]wןz) }s2[p.\
6:KK)5;hXӔd;vlbq wҺt֬Y9st{
y,_ [nN[o^{Xdy!DniѢE&'j5,YszV[O=Tr-fW01o<_XiV[n1s%keWs!˽1rYYyKXp!Z""" ǡN'|braN!!!x}vݻwc4hZ C=}ٓ'OMzj`HMMEpp0q^r |A;u ^ `7Kpc>}: <:\xj +W_7Y}: dmh:Zx1֯_owƼye֟I``GY@,?v^` q:aaa&(8
3D"+? H$>5k` V&
wڴiعs'VXau]RRR߷+3`,˺5o3Ǐ СC1k,l߾ K.rڕdvm/$$7n/ܫ+Rcnuzæt[l1\ofgv;Vq vXL<lnsb8u `\MzSRRz] 0hHII\NNRiXrO8|0N+!Ʌ1cVu!VqהRdggc._E}ޠAf dWϝ;\xwWO/ uWJJJlS"~ =o #F@SSS;(PTh4>!Imm-0n8g<4.!HMM;ej(//GAE475uj5 D"1C\|<z%p A)t RDNN]ﯦH$¸q㐕t0? ygQ{5U 2&
> aʑ(t:deeaȑ B1s;Ǐ@gfF[R0
s 26uH1))]`4:R999w2)}N-_ں,
%غS͙zdP(Vo[cσ8Z;nr}}=@T"f DGG\8| mZeKMu:=Vf
r2h48&3s{,N =FA1$y8]7e3:î 6, ٽ0!ދ[ X V J]7ֆ7!ضiq""UW!88i.jΝ=3YQoewR ! 0r9lW8qƍpÁ6YTX{ի6:j5
pD'x^NtX]س,ҧf=ȭ-P$- H H H J98*B/l6:Ç{,B@eeekĩS֝+nrtL,bscPTFSwss<σ8Rion|WTXR?Fz455yeD) B^^ T*b1R)d2BCCM![$ -B 4hFJ Aq >qq scdhhhJe?aŖ6e-VԺjC3P_xukk+Ν;RǛCTX
0|pd2;w^=筸mI"`@)5vH$H$2644cN RoTVV̙3Cbbd2$&&BTƍsh =BYYbժ8p6qu%8< n2 P(xE p hRmRʽ 3b\7}:0` ݳ W/z_@ ҧ@ܠ9
jkP SeErd!b8sNS
4DҙI? 126H|Bnq0,9EIA>J H ?B#0dH5zM]wѕ-NCKK bG)
PVxo!#=v""wE!P+FDN^vĬϞƍ.PgkLEkk+ V c44CRAĉ ChXbcc=v,l
T
VvVbBr rWIK.0&v fˑ|c'NG>h<oOVY>V}]-^ӈO_XP ])g .d+ZDEEY^HnVJ`RQQR NTjQ7]RAXe š#*F+8
VN8 @ExȜ1>--8J̲ T ѣ.BB@ttystL # ud,:dY?sʵ>zmjRPM3A4 0 ۷XY8b .S>|8N<#F830` MYM*+pR
E7m # [+ٜ JJO@<#QV MpoA@^^ RRR~H$;F ;-5e!ɠP(+ ohBHԲgO[5a`P6n.Tq <X>~VU}>1&B* kԫz%44
o "NALz< !!6CRW_FCY\)xk]O_,O햹~OSB? vx%{mr'iDTCm&+R#&&ƣnRY T1*C*\l ~3 : +`o
[m=<={ ?6b=! ,6RJQ\@$ % J)rssl#Ys߮ N . 444:%ϕOE1V_,G} T&Z-3: V9GF㱿B\ /˗IAKK P(cmMM
JKKifSh48w&s {!ޅ)o
*ZP؆;?VUmOj]\ RFϯ9saaa}kAPXXK.!<< ft:ף
Æ
(cDWrN Apf0T"8iz}F'j' @xJ7l `{qZC6`dz,Yaɽr- %WJQP\ek (xS&gxDj())Ayy9j5 <4
T*t: 0` w|#)~Za 1y^\?5Y4UA0¢/*6w6aPV ` ~ SlximmŁpU)B:-~@@ӂa~
Ó8 Z---PPMd2GDީ=}eRT 1qLugsNZڦ~ok.]0g JU@t\ jDRp% u|?F åU\R. j) hn+Le/&C SM{!@+ nkrϟR,b?G῾p{ ¡*)jޖ(0uDHcc#Μ< 2a0R1tq {&nL4 ^- mMоœB$ʀ
b.u8Ωvz:͖Md
&bup>UUU(+GMM5xࡃ "2CL {VClڱ1qm8ex ל偸`lD)L.v淠BgD5R̙ |XN568^DU-AI-C;>߶k3ٜ;ϹK ֜ nwvI,X.T*n>&͍x5 4
?3iYfقk]P8B?=N 2XP9mrԇ͆ϱu&o呔R_Բ[6olVgG@LKH$v%O>*T{Nbk/^͟mjB\Pt `E@E }~X省ůGXeR5=/}y
.ٰ5^xv}r-aYOkNCd]=p6 կ SS ݿ5+
>Ro/|۔35tiڴi CZ02kV<ǛLM?(Ik1"R4w^ .b7_
Yi׳m.lϞzw#b/X6{JR,] ͺޢ755c(QF5]
DC6fTdg7^EcC-uqw= W%A@AQ1/_F@)XBR`x`rS %䟷
EA[ w}ztģl`O0Mv_;V䣢Z~;셮c}.sϡZڈa/t +d4#IeO =wWÇpUx
x]҇1 ϞQ
{iSWK7<^*N rVZg]ۖ[> ̾v`{@%9BWB6`]2P?9j{`u+Vw ZK>Eھ{`>f.>!6K2H˘-BWї .IVN"රÌ>Lpxn|BD:ϕBWl]vI .{!A u?,
,[0)5%!)6%}8ZԭBW idLi]҇c BW/lvI ӗ셮_ n)>.70sc/E 8{B6|5 P:F1U ]E2K_}jP*էB6d֬~k
㮇 %y}e*)h0|er.» $g {P2> Xg!Kv ]Of% C
-`ܹ o.i>{
7nJ% {~ܵ&|BիWse(s/.0 2Lǽ>gl ?~ <m X"}.yxn|-([Zl9P`l'0{O`]2$, = .z>!;e f>E(Y~b^H ~a._H ف ^d = duT&ò{ s]n{~ ~c ?awף/Y1
<XOKTU`>{' .I@; M1o2J%_X%}B'd,7_ a.)6}!vl]|B'd`aJTk877f]ro;P*m)^AAm|y}麸0 e\-ErpюO fM&vI v P* O #+ im z8>!{8͞ ' XTiǾ_w{!!䬚o_/:0O^²s*|E !>{7a]7|B'd/ |B/'d/֛f$4w`'!@KxӖ]'] r &$E xrO;ww}؏O}g!>C% |9$=իW]f '>ŋ$u&쒧db>{a'>JG^ÇO?0
K %tEXtdate:create 2021-10-13T16:26:39+00:002 %tEXtdate:modify 2021-03-31T19:54:36+00:004#M tEXtSoftware www.inkscape.org< IENDB` rsconnect/man/figures/lifecycle-archived.svg 0000644 0001762 0000144 00000002430 14513230050 020722 0 ustar ligges users
rsconnect/man/figures/lifecycle-soft-deprecated.svg 0000644 0001762 0000144 00000002466 14513230050 022217 0 ustar ligges users
rsconnect/man/figures/logo.svg 0000644 0001762 0000144 00000402516 14435652570 016173 0 ustar ligges users
rsconnect/man/figures/lifecycle-questioning.svg 0000644 0001762 0000144 00000002444 14513230050 021507 0 ustar ligges users
rsconnect/man/figures/lifecycle-superseded.svg 0000644 0001762 0000144 00000002440 14513230050 021301 0 ustar ligges users
rsconnect/man/figures/lifecycle-stable.svg 0000644 0001762 0000144 00000002472 14513230050 020415 0 ustar ligges users
rsconnect/man/figures/lifecycle-experimental.svg 0000644 0001762 0000144 00000002450 14513230050 021634 0 ustar ligges users
rsconnect/man/figures/lifecycle-deprecated.svg 0000644 0001762 0000144 00000002440 14513230050 021236 0 ustar ligges users
rsconnect/man/deployApp.Rd 0000644 0001762 0000144 00000031037 14536333553 015265 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deployApp.R
\name{deployApp}
\alias{deployApp}
\title{Deploy an Application}
\usage{
deployApp(
appDir = getwd(),
appFiles = NULL,
appFileManifest = NULL,
appPrimaryDoc = NULL,
appSourceDoc = NULL,
appName = NULL,
appTitle = NULL,
envVars = NULL,
appId = NULL,
appMode = NULL,
contentCategory = NULL,
account = NULL,
server = NULL,
upload = TRUE,
recordDir = NULL,
launch.browser = getOption("rsconnect.launch.browser", is_interactive()),
on.failure = NULL,
logLevel = c("normal", "quiet", "verbose"),
lint = TRUE,
metadata = list(),
forceUpdate = NULL,
python = NULL,
forceGeneratePythonEnvironment = FALSE,
quarto = NA,
appVisibility = NULL,
image = NULL,
envManagement = NULL,
envManagementR = NULL,
envManagementPy = NULL,
space = NULL
)
}
\arguments{
\item{appDir}{A directory containing an application (e.g. a Shiny app
or plumber API). Defaults to the current directory.}
\item{appFiles, appFileManifest}{Use \code{appFiles} to specify a
character vector of files to bundle in the app or \code{appManifestFiles}
to provide a path to a file containing a list of such files. If neither
are supplied, will bundle all files in \code{appDir}, apart from standard
exclusions and files listed in a \code{.rscignore} file. See
\code{\link[=listDeploymentFiles]{listDeploymentFiles()}} for more details.}
\item{appPrimaryDoc}{If the application contains more than one document, this
parameter indicates the primary one, as a path relative to \code{appDir}. Can be
\code{NULL}, in which case the primary document is inferred from the contents
being deployed.}
\item{appSourceDoc}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use
\code{recordDir} instead.}
\item{appName}{Application name, a string consisting of letters, numbers,
\verb{_} and \code{-}. The application name is used to identify applications on a
server, so must be unique.
If not specified, the first deployment will be automatically it from the
\code{appDir} for directory and website, and from the \code{appPrimaryDoc} for
document. On subsequent deploys, it will use the previously stored value.}
\item{appTitle}{Free-form descriptive title of application. Optional; if
supplied, will often be displayed in favor of the name. If ommitted,
on second and subsequent deploys, the title will be unchanged.}
\item{envVars}{A character vector giving the names of environment variables
whose values should be synchronised with the server (currently supported by
Connect only). The values of the environment variables are sent over an
encrypted connection and are not stored in the bundle, making this a safe
way to send private data to Connect.
The names (not values) are stored in the deployment record so that future
deployments will automatically update their values. Other environment
variables on the server will not be affected. This means that removing an
environment variable from \code{envVars} will leave it unchanged on the server.
To remove it, either delete it using the Connect UI, or temporarily unset
it (with \code{Sys.unsetenv()} or similar) then re-deploy.
Environment variables are set prior to deployment so that your code
can use them and the first deployment can still succeed. Note that means
that if the deployment fails, the values will still be updated.}
\item{appId}{Use this to deploy to an exact known application, ignoring all
existing deployment records and \code{appName}.
You can use this to update an existing application that is missing a
deployment record. If you're re-deploying an application that you
created it's generally easier to use \code{appName}; \code{appId} is best reserved
for re-deploying apps created by someone else.
You can find the \code{appId} in the following places:
\itemize{
\item On shinyapps.io, it's the \code{id} listed on the applications page.
\item For Posit Connect, it's \code{guid} from the info tab on the content page.
}}
\item{appMode}{Optional; the type of content being deployed.
Provide this option when the inferred type of content is incorrect. This
can happen, for example, when static HTML content includes a downloadable
Shiny application \code{app.R}. Accepted values include \code{"shiny"}, \code{"api"},
\code{"rmd-static"}, \code{"rmd-shiny"}, \code{"quarto-static"}, \code{"quarto-shiny"}, and
\code{"static"}. The Posit Connect API Reference contains a full set of
available values. Not all servers support all types of content.}
\item{contentCategory}{Optional; classifies the kind of content being
deployed (e.g. \code{"plot"} or \code{"site"}).}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
\item{upload}{If \code{TRUE} (the default) then the application is uploaded from
the local system prior to deployment. If \code{FALSE} then it is re-deployed
using the last version that was uploaded. \code{FALSE} is only supported on
shinyapps.io; \code{TRUE} is required on Posit Connect.}
\item{recordDir}{Directory where deployment record is written. The default,
\code{NULL}, uses \code{appDir}, since this is usually where you want the deployment
data to be stored. This argument is typically only needed when deploying
a directory of static files since you want to store the record with the
code that generated those files, not the files themselves.}
\item{launch.browser}{If true, the system's default web browser will be
launched automatically after the app is started. Defaults to \code{TRUE} in
interactive sessions only. If a function is passed, it will be called
after the app is started, with the app URL as a paramter.}
\item{on.failure}{Function to be called if the deployment fails. If a
deployment log URL is available, it's passed as a parameter.}
\item{logLevel}{One of \code{"quiet"}, \code{"normal"} or \code{"verbose"}; indicates how
much logging to the console is to be performed. At \code{"quiet"} reports no
information; at \code{"verbose"}, a full diagnostic log is captured.}
\item{lint}{Lint the project before initiating deployment, to identify
potentially problematic code?}
\item{metadata}{Additional metadata fields to save with the deployment
record. These fields will be returned on subsequent calls to
\code{\link[=deployments]{deployments()}}.
Multi-value fields are recorded as comma-separated values and returned in
that form. Custom value serialization is the responsibility of the caller.}
\item{forceUpdate}{What should happen if there's no deployment record for
the app, but there's an app with the same name on the server? If \code{TRUE},
will always update the previously-deployed app. If \code{FALSE}, will ask
the user what to do, or fail if not in an interactive context.
Defaults to \code{TRUE} when called automatically by the IDE, and \code{FALSE}
otherwise. You can override the default by setting option
\code{rsconnect.force.update.apps}.}
\item{python}{Full path to a python binary for use by \code{reticulate}.
Required if \code{reticulate} is a dependency of the app being deployed.
If python = NULL, and RETICULATE_PYTHON or RETICULATE_PYTHON_FALLBACK is
set in the environment, its value will be used. The specified python binary
will be invoked to determine its version and to list the python packages
installed in the environment.}
\item{forceGeneratePythonEnvironment}{Optional. If an existing
\code{requirements.txt} file is found, it will be overwritten when this argument
is \code{TRUE}.}
\item{quarto}{Should the deployed content be built by quarto?
(\code{TRUE}, \code{FALSE}, or \code{NA}). The default, \code{NA}, will use quarto if
there are \code{.qmd} files in the bundle, or if there is a
\verb{_quarto.yml} and \code{.Rmd} files.
(This option is ignored and quarto will always be used if the
\code{metadata} contains \code{quarto_version} and \code{quarto_engines} fields.)}
\item{appVisibility}{One of \code{NULL}, \code{"private"}, or \code{"public"}; the
visibility of the deployment. When \code{NULL}, no change to visibility is
made. Currently has an effect only on deployments to shinyapps.io.}
\item{image}{Optional. The name of the image to use when building and
executing this content. If none is provided, Posit Connect will
attempt to choose an image based on the content requirements.}
\item{envManagement}{Optional. Should Posit Connect install R and Python
packages for this content? (\code{TRUE}, \code{FALSE}, or \code{NULL}).
The default, \code{NULL}, will not write any values to the bundle manifest,
and Connect will fall back to the application default environment
management strategy, or the server default if no application default
is defined.
(This option is a shorthand flag which overwrites the values of both
\code{envManagementR} and \code{envManagementPy}.)}
\item{envManagementR}{Optional. Should Posit Connect install R packages
for this content? (\code{TRUE}, \code{FALSE}, or \code{NULL}). The default, \code{NULL}, will
not write any values to the bundle manifest, and Connect will fall back to
the application default R environment management strategy, or the server
default if no application default is defined.
(This option is ignored when \code{envManagement} is non-\code{NULL}.)}
\item{envManagementPy}{Optional. Should Posit Connect install Python packages
for this content? (\code{TRUE}, \code{FALSE}, or \code{NULL}). The default, \code{NULL}, will
not write any values to the bundle manifest, and Connect will fall back to
the application default Python environment management strategy, or the
server default if no application default is defined.
(This option is ignored when \code{envManagement} is non-\code{NULL}.)}
\item{space}{Optional. For Posit Cloud, the id of the space where the content
should be deployed. If none is provided, content will be deployed to the
deploying user's workspace or deployed to the same space in case of
redeploy.}
}
\description{
Deploy a \link[shiny:shiny-package]{shiny} application, an
\link[rmarkdown:rmarkdown-package]{RMarkdown} document, a plumber API, or HTML
content to a server.
}
\details{
\subsection{Deployment records}{
When deploying an app, \code{deployApp()} will save a deployment record that
makes it easy to update the app on server from your local source code. This
generally means that you need to only need to supply important arguments
(e.g. \code{appName}, \code{appTitle}, \code{server}/\code{account}) on the first deploy, and
rsconnect will reuse the same settings on subsequent deploys.
The metadata needs to make this work is stored in \verb{\{appDir\}/rsconnect/}.
You should generally check these files into version control to ensure that
future you and other collaborators will publish to the same location.
If you have lost this directory, all is not lost, as \code{deployApp()} will
attempt to rediscover existing deployments. This is easiest if you are
updating an app that you created, as you can just supply the \code{appName}
(and \code{server}/\code{account} if you have multiple accounts) and \code{deployApp()}
will find the existing application account. If you need to update an app
that was created by someone else (that you have write permission) for, you'll
instead need to supply the \code{appId}.
}
}
\examples{
\dontrun{
# deploy the application in the current working dir
deployApp()
# deploy an application in another directory
deployApp("~/projects/shiny/app1")
# deploy using an alternative application name and title
deployApp("~/projects/shiny/app1", appName = "myapp",
appTitle = "My Application")
# deploy specifying an explicit account name, then
# redeploy with no arguments (will automatically use
# the previously specified account)
deployApp(account = "jsmith")
deployApp()
# deploy but don't launch a browser when completed
deployApp(launch.browser = FALSE)
# deploy a Quarto website, using the quarto package to
# find the Quarto binary
deployApp("~/projects/quarto/site1")
# deploy application with environment variables
# (e.g., `SECRET_PASSWORD=XYZ` is set via an ~/.Renviron file)
rsconnect::deployApp(envVars = c("SECRET_PASSWORD"))
}
}
\seealso{
\code{\link[=applications]{applications()}}, \code{\link[=terminateApp]{terminateApp()}}, and \code{\link[=restartApp]{restartApp()}}
Other Deployment functions:
\code{\link{applications}()},
\code{\link{deployAPI}()},
\code{\link{deployDoc}()},
\code{\link{deploySite}()},
\code{\link{deployTFModel}()}
}
\concept{Deployment functions}
rsconnect/man/showProperties.Rd 0000644 0001762 0000144 00000001521 14514472171 016354 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/configureApp.R
\name{showProperties}
\alias{showProperties}
\title{Show Application property}
\usage{
showProperties(
appPath = getwd(),
appName = NULL,
account = NULL,
server = NULL
)
}
\arguments{
\item{appPath}{Directory or file that was deployed. Defaults to current
working directory.}
\item{appName}{Name of application}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
}
\description{
Show properties of an application deployed to ShinyApps.
}
\note{
This function works only for ShinyApps servers.
}
rsconnect/man/listDeploymentFiles.Rd 0000644 0001762 0000144 00000004322 14513230050 017303 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/bundleFiles.R
\name{listDeploymentFiles}
\alias{listDeploymentFiles}
\title{Gather files to be bundled with an app}
\usage{
listDeploymentFiles(
appDir,
appFiles = NULL,
appFileManifest = NULL,
error_call = caller_env()
)
}
\arguments{
\item{appDir}{A directory containing an application (e.g. a Shiny app
or plumber API). Defaults to the current directory.}
\item{appFiles, appFileManifest}{Use \code{appFiles} to specify a
character vector of files to bundle in the app or \code{appManifestFiles}
to provide a path to a file containing a list of such files. If neither
are supplied, will bundle all files in \code{appDir}, apart from standard
exclusions and files listed in a \code{.rscignore} file. See
\code{\link[=listDeploymentFiles]{listDeploymentFiles()}} for more details.}
\item{error_call}{The call or environment for error reporting; expert
use only.}
}
\value{
Character of paths to bundle, relative to \code{appDir}.
}
\description{
Given an app directory, and optional \code{appFiles} and \code{appFileManifest}
arguments, returns vector of paths to bundle in the app. (Note that
documents follow a different strategy; see \code{\link[=deployDoc]{deployDoc()}} for details.)
When neither \code{appFiles} nor \code{appFileManifest} is supplied,
\code{listDeploymentFiles()} will include all files under \code{appDir}, apart
from the following:
\itemize{
\item Certain files and folders that don't need to be bundled, such as
version control directories, internal config files, and RStudio state,
are automatically excluded.
\item You can exclude additional files by listing them in in a \code{.rscignore}
file. This file must have one file or directory per line (with path
relative to the current directory). It doesn't support wildcards, or
ignoring files in subdirectories.
}
\code{listDeploymentFiles()} will throw an error if the total file size exceeds
the maximum bundle size (as controlled by option \code{rsconnect.max.bundle.size}),
or the number of files exceeds the maximum file limit (as controlled by
option \code{rsconnect.max.bundle.files}). This prevents you from accidentally
bundling a very large direcfory (i.e. you home directory).
}
rsconnect/man/resendInvitation.Rd 0000644 0001762 0000144 00000002136 14513230050 016632 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/auth.R
\name{resendInvitation}
\alias{resendInvitation}
\title{Resend invitation for invited users of an application}
\usage{
resendInvitation(
invite,
regenerate = FALSE,
appDir = getwd(),
appName = NULL,
account = NULL,
server = NULL
)
}
\arguments{
\item{invite}{The invitation to resend. Can be id or email address.}
\item{regenerate}{Regenerate the invite code. Can be helpful is the
invitation has expired.}
\item{appDir}{Directory containing application. Defaults to
current working directory.}
\item{appName}{Name of application.}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
}
\description{
Resend invitation for invited users of an application
}
\note{
This function works only for ShinyApps servers.
}
\seealso{
\code{\link[=showInvited]{showInvited()}}
}
rsconnect/man/terminateApp.Rd 0000644 0001762 0000144 00000001765 14435652570 015767 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/terminateApp.R
\name{terminateApp}
\alias{terminateApp}
\title{Terminate an Application}
\usage{
terminateApp(appName, account = NULL, server = NULL, quiet = FALSE)
}
\arguments{
\item{appName}{Name of application to terminate}
\item{account}{Account name. If a single account is registered on the system
then this parameter can be omitted.}
\item{server}{Server name. Required only if you use the same account name on
multiple servers (see \code{\link[=servers]{servers()}})}
\item{quiet}{Request that no status information be printed to the console
during the termination.}
}
\description{
Terminate and archive a currently deployed ShinyApps application.
}
\note{
This function only works for ShinyApps servers.
}
\examples{
\dontrun{
# terminate an application
terminateApp("myapp")
}
}
\seealso{
\code{\link[=applications]{applications()}}, \code{\link[=deployApp]{deployApp()}}, and
\code{\link[=restartApp]{restartApp()}}
}
rsconnect/man/appDependencies.Rd 0000644 0001762 0000144 00000013603 14513230050 016375 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/appDependencies.R
\name{appDependencies}
\alias{appDependencies}
\title{Detect application dependencies}
\usage{
appDependencies(
appDir = getwd(),
appFiles = NULL,
appFileManifest = NULL,
appMode = NULL
)
}
\arguments{
\item{appDir}{A directory containing an application (e.g. a Shiny app
or plumber API). Defaults to the current directory.}
\item{appFiles, appFileManifest}{Use \code{appFiles} to specify a
character vector of files to bundle in the app or \code{appManifestFiles}
to provide a path to a file containing a list of such files. If neither
are supplied, will bundle all files in \code{appDir}, apart from standard
exclusions and files listed in a \code{.rscignore} file. See
\code{\link[=listDeploymentFiles]{listDeploymentFiles()}} for more details.}
\item{appMode}{Optional; the type of content being deployed.
Provide this option when the inferred type of content is incorrect. This
can happen, for example, when static HTML content includes a downloadable
Shiny application \code{app.R}. Accepted values include \code{"shiny"}, \code{"api"},
\code{"rmd-static"}, \code{"rmd-shiny"}, \code{"quarto-static"}, \code{"quarto-shiny"}, and
\code{"static"}. The Posit Connect API Reference contains a full set of
available values. Not all servers support all types of content.}
}
\value{
A data frame with one row for each dependency (direct, indirect,
and inferred), and 4 columns:
\itemize{
\item \code{Package}: package name.
\item \code{Version}: local version.
\item \code{Source}: a short string describing the source of the package install,
as described above.
\item \code{Repository}: for CRAN and CRAN-like repositories, the URL to the
repository. This will be ignored by the server if it has been configured
with its own repository name -> repository URL mapping.
}
}
\description{
\code{appDependencies()} recursively detects all R package dependencies for an
application by parsing all \code{.R} and \code{.Rmd} files and looking for calls
to \code{library()}, \code{require()}, \code{requireNamespace()}, \code{::}, and so on.
It then adds implicit dependencies (i.e. an \code{.Rmd} requires Rmarkdown)
and adds all recursive dependencies to create a complete manifest of
package packages need to be installed to run the app.
}
\section{Dependency discovery}{
rsconnect use one of three mechanisms to find which packages your application
uses:
\enumerate{
\item If \code{renv.lock} is present, it will use the versions and sources defined in
that file. If you're using the lockfile for some other purpose and
don't want it to affect deployment, add \code{renv.lock} to \code{.rscignore}.
\item Otherwise, rsconnect will call \code{renv::snapshot()} to find all packages
used by your code. If you'd instead prefer to only use the packages
declared in a \code{DESCRIPTION} file, run
\code{renv::settings$snapshot.type("explicit")} to activate renv's "explicit"
mode.
\item Dependency resolution using renv is a new feature in rsconnect 1.0.0, and
while we have done our best to test it, it still might fail for your app.
If this happens, please \href{https://github.com/rstudio/rsconnect/issues}{file an issue}
then set \code{options(rsconnect.packrat = TRUE)} to revert to the old
dependency discovery mechanism.
}
}
\section{Remote installation}{
When deployed, the app must first install all of these packages, and
rsconnect ensures the versions used on the server will match the versions
you used locally. It knows how to install packages from the following
sources:
\itemize{
\item CRAN and BioConductor (\code{Source: CRAN} or \code{Source: Bioconductor}). The
remote server will ignore the specific CRAN or Bioconductor mirror that
you use locally, always using the CRAN/BioC mirror that has been configured
on the server.
\item Other CRAN like and CRAN-like repositories. These packages will have
a \code{Source} determined by the value of \code{getOptions("repos")}. For example,
if you've set the following options:
\if{html}{\out{
}}
Then packages installed from your corporate package repository will
have source \code{CORPORATE}. Posit Connect
\href{https://docs.posit.co/connect/admin/appendix/configuration/#RPackageRepository}{can be configured}
to override their repository url so that (e.g.) you can use different
packages versions on staging and production servers.
\item Packages installed from GitHub, GitLab, or BitBucket, have \code{Source}
\code{github}, \code{gitlab}, and \code{bitbucket} respectively. When deployed, the
bundle contains the additional metadata needed to precisely recreated
the installed version.
}
It's not possible to recreate the packages that you have built and installed
from a directory on your local computer. This will have \code{Source: NA} and
will cause the deployment to error. To resolve this issue, you'll need to
install from one of the known sources described above.
}
\section{Suggested packages}{
The \code{Suggests} field is not included when determining recursive dependencies,
so it's possible that not every package required to run your application will
be detected.
For example, ggplot2's \code{geom_hex()} requires the hexbin package to be
installed, but it is only suggested by ggplot2. So if your app uses
\code{geom_hex()} it will fail, reporting that the hexbin package is not
installed.
You can overcome this problem with (e.g.) \code{requireNamespace(hexbin)}.
This will tell rsconnect that your app needs the hexbin package, without
otherwise affecting your code.
}
\examples{
\dontrun{
# dependencies for the app in the current working dir
appDependencies()
# dependencies for an app in another directory
appDependencies("~/projects/shiny/app1")
}
}
\seealso{
\link{rsconnectPackages}(Using Packages with rsconnect)
}
rsconnect/man/accountUsage.Rd 0000644 0001762 0000144 00000002144 14513230050 015725 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/usage.R
\name{accountUsage}
\alias{accountUsage}
\title{Show Account Usage}
\usage{
accountUsage(
account = NULL,
server = NULL,
usageType = "hours",
from = NULL,
until = NULL,
interval = NULL
)
}
\arguments{
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
\item{usageType}{Use metric to retreive (for example: "hours")}
\item{from}{Date range starting timestamp (Unix timestamp or relative time
delta such as "2d" or "3w").}
\item{until}{Date range ending timestamp (Unix timestamp or relative time
delta such as "2d" or "3w").}
\item{interval}{Summarization interval. Data points at intervals less then this
will be grouped. (Number of seconds or relative time delta e.g. "1h").}
}
\description{
Show account usage
}
\note{
This function only works for ShinyApps servers.
}
rsconnect/man/deploySite.Rd 0000644 0001762 0000144 00000006733 14514472171 015452 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deploySite.R
\name{deploySite}
\alias{deploySite}
\title{Deploy a website}
\usage{
deploySite(
siteDir = getwd(),
siteName = NULL,
siteTitle = NULL,
account = NULL,
server = NULL,
render = c("none", "local", "server"),
launch.browser = getOption("rsconnect.launch.browser", interactive()),
logLevel = c("normal", "quiet", "verbose"),
lint = FALSE,
metadata = list(),
python = NULL,
recordDir = NULL,
...
)
}
\arguments{
\item{siteDir}{Directory containing website. Defaults to current directory.}
\item{siteName}{Name for the site (names must be unique within
an account). Defaults to the base name of the specified \code{siteDir}
or to the name provided by a custom site generation function.}
\item{siteTitle}{Title for the site. For quarto sites only, if not
supplied uses the title recorded in \verb{_quarto.yml}.}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
\item{render}{Rendering behavior for site:
\itemize{
\item \code{"none"} uploads a static version of the current contents of
the site directory.
\item \code{"local"} renders the site locally then uploads it.
\item \code{"server"} uploads the source of the site to render on the server.
}
Note that for \code{"none"} and \code{"local"} source files (e.g. \code{.R}, \code{.Rmd} and
\code{.md}) will not be uploaded to the server.}
\item{launch.browser}{If true, the system's default web browser will be
launched automatically after the app is started. Defaults to \code{TRUE} in
interactive sessions only. If a function is passed, it will be called
after the app is started, with the app URL as a paramter.}
\item{logLevel}{One of \code{"quiet"}, \code{"normal"} or \code{"verbose"}; indicates how
much logging to the console is to be performed. At \code{"quiet"} reports no
information; at \code{"verbose"}, a full diagnostic log is captured.}
\item{lint}{Lint the project before initiating deployment, to identify
potentially problematic code?}
\item{metadata}{Additional metadata fields to save with the deployment
record. These fields will be returned on subsequent calls to
\code{\link[=deployments]{deployments()}}.
Multi-value fields are recorded as comma-separated values and returned in
that form. Custom value serialization is the responsibility of the caller.}
\item{python}{Full path to a python binary for use by \code{reticulate}.
Required if \code{reticulate} is a dependency of the app being deployed.
If python = NULL, and RETICULATE_PYTHON or RETICULATE_PYTHON_FALLBACK is
set in the environment, its value will be used. The specified python binary
will be invoked to determine its version and to list the python packages
installed in the environment.}
\item{recordDir}{The default, \code{NULL}, uses \code{siteDir}.}
\item{...}{Additional arguments to \code{\link[=deployApp]{deployApp()}}. Do not supply \code{appDir}
or \code{appFiles}; these parameters are automatically generated by
\code{deploySite()}.}
}
\description{
Deploy an R Markdown or quarto website to a server.
}
\seealso{
Other Deployment functions:
\code{\link{applications}()},
\code{\link{deployAPI}()},
\code{\link{deployApp}()},
\code{\link{deployDoc}()},
\code{\link{deployTFModel}()}
}
\concept{Deployment functions}
rsconnect/man/forgetDeployment.Rd 0000644 0001762 0000144 00000002550 14435652570 016656 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deployments.R
\name{forgetDeployment}
\alias{forgetDeployment}
\title{Forget Application Deployment}
\usage{
forgetDeployment(
appPath = getwd(),
name = NULL,
account = NULL,
server = NULL,
dryRun = FALSE,
force = !interactive()
)
}
\arguments{
\item{appPath}{The path to the content that was deployed, either a directory
or an individual document.}
\item{name}{The name of the content that was deployed (optional)}
\item{account}{The name of the account to which the content was deployed
(optional)}
\item{server}{The name of the server to which the content was deployed
(optional)}
\item{dryRun}{Set to TRUE to preview the files/directories to be removed
instead of actually removing them. Defaults to FALSE.}
\item{force}{Set to TRUE to remove files and directories without prompting.
Defaults to FALSE in interactive sessions.}
}
\value{
NULL, invisibly.
}
\description{
Forgets about an application deployment. This is useful if the application
has been deleted on the server, or the local deployment information needs to
be reset.
}
\details{
This method removes from disk the file containing deployment
metadata. If "name", "account", and "server" are all NULL, then all of the
deployments for the application are forgotten; otherwise, only the
specified deployment is forgotten.
}
rsconnect/man/authorizedUsers.Rd 0000644 0001762 0000144 00000000632 14435652570 016526 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/auth.R
\name{authorizedUsers}
\alias{authorizedUsers}
\title{(Deprecated) List authorized users for an application}
\usage{
authorizedUsers(appDir = getwd())
}
\arguments{
\item{appDir}{Directory containing application. Defaults to current working
directory.}
}
\description{
(Deprecated) List authorized users for an application
}
rsconnect/man/rpubsUpload.Rd 0000644 0001762 0000144 00000003750 14435652570 015632 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/rpubs.R
\name{rpubsUpload}
\alias{rpubsUpload}
\title{Upload a file to RPubs}
\usage{
rpubsUpload(title, contentFile, originalDoc, id = NULL, properties = list())
}
\arguments{
\item{title}{The title of the document.}
\item{contentFile}{The path to the content file to upload.}
\item{originalDoc}{The document that was rendered to produce the
\code{contentFile}. May be \code{NULL} if the document is not known.}
\item{id}{If this upload is an update of an existing document then the id
parameter should specify the document id to update. Note that the id is
provided as an element of the list returned by successful calls to
\code{rpubsUpload}.}
\item{properties}{A named list containing additional document properties
(RPubs doesn't currently expect any additional properties, this parameter
is reserved for future use).}
}
\value{
A named list. If the upload was successful then the list contains a
\code{id} element that can be used to subsequently update the document as
well as a \code{continueUrl} element that provides a URL that a browser
should be opened to in order to complete publishing of the document. If the
upload fails then the list contains an \code{error} element which contains
an explanation of the error that occurred.
}
\description{
This function publishes a file to rpubs.com. If the upload succeeds a
list that includes an \code{id} and \code{continueUrl} is returned. A browser
should be opened to the \code{continueUrl} to complete publishing of the
document. If an error occurs then a diagnostic message is returned in the
\code{error} element of the list.
}
\examples{
\dontrun{
# upload a document
result <- rpubsUpload("My document title", "Document.html")
if (!is.null(result$continueUrl))
browseURL(result$continueUrl)
else
stop(result$error)
# update the same document with a new title
updateResult <- rpubsUpload("My updated title", "Document.html",
id = result$id)
}
}
rsconnect/man/accounts.Rd 0000644 0001762 0000144 00000002521 14513230050 015122 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/accounts.R
\name{accounts}
\alias{accounts}
\alias{accountInfo}
\alias{removeAccount}
\title{Account Management Functions}
\usage{
accounts(server = NULL)
accountInfo(name = NULL, server = NULL)
removeAccount(name = NULL, server = NULL)
}
\arguments{
\item{server}{Name of the server on which the account is registered
(optional; see \code{\link[=servers]{servers()}})}
\item{name}{Name of account}
}
\value{
\code{accounts} returns a data frame with the names of all accounts
registered on the system and the servers on which they reside.
\code{accountInfo} returns a list with account details.
}
\description{
Functions to enumerate and remove accounts on the local system. Prior to
deploying applications you need to register your account on the local system.
}
\details{
You register an account using the \code{\link[=setAccountInfo]{setAccountInfo()}} function (for
ShinyApps) or \code{\link[=connectUser]{connectUser()}} function (for other servers). You can
subsequently remove the account using the \code{removeAccount} function.
The \code{accounts} and \code{accountInfo} functions are provided for viewing
previously registered accounts.
}
\seealso{
Other Account functions:
\code{\link{connectApiUser}()},
\code{\link{setAccountInfo}()}
}
\concept{Account functions}
rsconnect/man/makeLinterMessage.Rd 0000644 0001762 0000144 00000001067 14513230050 016707 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lint.R
\name{makeLinterMessage}
\alias{makeLinterMessage}
\title{Construct a Linter Message}
\usage{
makeLinterMessage(header, content, lines)
}
\arguments{
\item{header}{A header message describing the linter.}
\item{content}{The content of the file that was linted.}
\item{lines}{The line numbers from \code{content} that contain lint.}
}
\description{
Pretty-prints a linter message. Primarily used as a helper
for constructing linter messages with \code{\link[=linter]{linter()}}.
}
rsconnect/man/oldApplicationConfigDir.Rd 0000644 0001762 0000144 00000001316 14513230050 020033 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/configMigrate.R
\name{oldApplicationConfigDir}
\alias{oldApplicationConfigDir}
\title{Old Application Config Directory}
\usage{
oldApplicationConfigDir(appName)
}
\arguments{
\item{appName}{The application's name (connect or rsconnect)}
}
\value{
The old application configuration directory.
}
\description{
Returns the old application configuration directory used by rsconnect
0.8.24 and prior. These versions wrote configuration data to XDG compliant
locations, but CRAN policy has since further restricted the disk locations
that are permitted. See:
}
\details{
https://cran.r-project.org/web/packages/policies.html
}
\keyword{internal}
rsconnect/man/showMetrics.Rd 0000644 0001762 0000144 00000004021 14513230050 015607 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/usage.R
\name{showMetrics}
\alias{showMetrics}
\title{Show Application Metrics}
\usage{
showMetrics(
metricSeries,
metricNames,
appDir = getwd(),
appName = NULL,
account = NULL,
server = "shinyapps.io",
from = NULL,
until = NULL,
interval = NULL
)
}
\arguments{
\item{metricSeries}{Metric series to query. Refer to the
\href{https://docs.posit.co/shinyapps.io/metrics.html#ApplicationMetrics}{shinyapps.io documentation}
for available series.}
\item{metricNames}{Metric names in the series to query. Refer to the
\href{https://docs.posit.co/shinyapps.io/metrics.html#ApplicationMetrics}{shinyapps.io documentation}
for available metrics.}
\item{appDir}{A directory containing an application (e.g. a Shiny app
or plumber API). Defaults to the current directory.}
\item{appName}{Application name, a string consisting of letters, numbers,
\verb{_} and \code{-}. The application name is used to identify applications on a
server, so must be unique.
If not specified, the first deployment will be automatically it from the
\code{appDir} for directory and website, and from the \code{appPrimaryDoc} for
document. On subsequent deploys, it will use the previously stored value.}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
\item{from}{Date range starting timestamp (Unix timestamp or relative time
delta such as "2d" or "3w").}
\item{until}{Date range ending timestamp (Unix timestamp or relative time
delta such as "2d" or "3w").}
\item{interval}{Summarization interval. Data points at intervals less then this
will be grouped. (Relative time delta e.g. "120s" or "1h" or "30d").}
}
\description{
Show application metrics of a currently deployed application.
This function only works for ShinyApps servers.
}
rsconnect/man/options.Rd 0000644 0001762 0000144 00000012603 14513230050 015000 0 ustar ligges users \name{rsconnectOptions}
\alias{rsconnectOptions}
\title{Package Options}
\description{
The \pkg{rsconnect} package supports several options that control the method used for http communications, the printing of diagnostic information for http requests, and the launching of an external browser after deployment.
}
\details{
Supported global options include:
\describe{
\item{\code{rsconnect.ca.bundle}}{Path to a custom bundle of Certificate Authority root certificates to use when connecting to servers via SSL. This option can also be specied in the environment variable \code{RSCONNECT_CA_BUNDLE}. Leave undefined to use your system's default certificate store.}
\item{\code{rsconnect.check.certificate}}{Whether to check the SSL certificate when connecting to a remote host; defaults to \code{TRUE}. Setting to \code{FALSE} is insecure, but will allow you to connect to hosts using invalid certificates as a last resort.}
\item{\code{rsconnect.http}}{Http implementation used for connections to the back-end service:
\tabular{ll}{
\code{libcurl} \tab Secure https using the \code{curl} R package\cr
\code{rcurl} \tab Secure https using the \code{Rcurl} R package (deprecated)\cr
\code{curl} \tab Secure https using the curl system utility \cr
\code{internal} \tab Insecure http using raw sockets\cr
}
If no option is specified then \code{libcurl} is used by default.
}
\item{\code{rsconnect.http.trace}}{When \code{TRUE}, trace http calls (prints the method, path, and total milliseconds for each http request)}
\item{\code{rsconnect.http.trace.json}}{When \code{TRUE}, trace JSON content (shows JSON payloads sent to and received from the server))}
\item{\code{rsconnect.http.verbose}}{When \code{TRUE}, print verbose output for http connections (useful only for debugging SSL certificate or http connection problems)}
\item{\code{rsconnect.tar}}{By default, \code{rsconnect} uses R's internal \code{tar} implementation to compress content bundles. This may cause invalid bundles in some environments. In those cases, use this option to specify a path to an alternate \code{tar} executable. This option can also be specified in the environment variable \code{RSCONNECT_TAR}. Leave undefined to use the default \code{tar} implementation.}
\item{\code{rsconnect.rcurl.options}}{A named list of additional cURL options to use when using the RCurl HTTP implementation in R. Run \code{RCurl::curlOptions()} to see available options.}
\item{\code{rsconnect.libcurl.options}}{A named list of additional cURL options to use when using the curl HTTP implementation in R. Run \code{curl::curl_options()} to see available options.}
\item{\code{rsconnect.error.trace}}{{When \code{TRUE}, print detailed stack traces for errors occurring during deployment.}}
\item{\code{rsconnect.launch.browser}}{When \code{TRUE}, automatically launch a browser to view applications after they are deployed}
\item{\code{rsconnect.locale.cache}}{When \code{FALSE}, disable the detected locale cache (Windows only). }
\item{\code{rsconnect.locale}}{Override the detected locale. }
\item{\code{rsconnect.max.bundle.size}}{The maximum size, in bytes, for deployed content. If not set, defaults to 3 GB.}
\item{\code{rsconnect.max.bundle.files}}{The maximum number of files to deploy. If not set, defaults to 10,000.}
\item{\code{rsconnect.force.update.apps}}{When \code{TRUE}, bypasses the prompt to confirm whether you wish to update previously-deployed content}
\item{\code{rsconnect.pre.deploy}}{A function to run prior to deploying content; it receives as an argument the directory containing the content about to be deployed.}
\item{\code{rsconnect.post.deploy}}{A function to run after successfully deploying content; it receives as an argument the directory containing the content about to be deployed.}
\item{\code{rsconnect.python.enabled}}{When \code{TRUE}, use the python executable specified by the \code{RETICULATE_PYTHON} environment variable and add a \code{python} section to the deployment manifest. By default, python is enabled when deploying to Posit Connect and disabled when deploying to shinyapps.io.}
}
When deploying content from the RStudio IDE, the rsconnect package's deployment methods are executed in a vanilla R session that doesn't execute startup scripts. This can make it challenging to ensure options are set properly prior to push-button deployment, so the rsconnect package has a parallel set of ``startup'' scripts it runs prior to deploying. The follow are run in order, if they exist, prior to deployment:
\describe{
\item{\code{$R_HOME/etc/rsconnect.site}}{Like \code{Rprofile.site}; for site-wide pre-flight and options.}
\item{\code{~/.rsconnect_profile}}{Like \code{.Rprofile}; for user-specific content.}
\item{\code{$PROJECT/.rsconnect_profile}}{Like \code{.Rprofile} for projects; \code{$PROJECT} here refers to the root directory of the content being deployed.}
}
Note that, unlike \code{.Rprofile}, these files don't replace each other; \emph{all three} will be run if they exist.
}
\examples{
\dontrun{
# use curl for http connections
options(rsconnect.http = "curl")
# trace http requests
options(rsconnect.http.trace = TRUE)
# print verbose output for http requests
options(rsconnect.http.verbose = TRUE)
# print JSON content
options(rsconnect.http.trace.json = TRUE)
# don't automatically launch a browser after deployment
options(rsconnect.launch.browser = FALSE)
}
}
rsconnect/man/restartApp.Rd 0000644 0001762 0000144 00000001742 14435652570 015456 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/restartApp.R
\name{restartApp}
\alias{restartApp}
\title{Restart an Application}
\usage{
restartApp(appName, account = NULL, server = NULL, quiet = FALSE)
}
\arguments{
\item{appName}{Name of application to restart}
\item{account}{Account name. If a single account is registered on the system
then this parameter can be omitted.}
\item{server}{Server name. Required only if you use the same account name on
multiple servers (see \code{\link[=servers]{servers()}})}
\item{quiet}{Request that no status information be printed to the console
during the operation.}
}
\description{
Restart an application currently running on a remote server.
}
\note{
This function works only for ShinyApps servers.
}
\examples{
\dontrun{
# restart an application
restartApp("myapp")
}
}
\seealso{
\code{\link[=applications]{applications()}}, \code{\link[=deployApp]{deployApp()}}, and
\code{\link[=terminateApp]{terminateApp()}}
}
rsconnect/man/listBundleFiles.Rd 0000644 0001762 0000144 00000002220 14513230050 016367 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/bundleFiles.R
\name{listBundleFiles}
\alias{listBundleFiles}
\title{List Files to be Bundled}
\usage{
listBundleFiles(appDir)
}
\arguments{
\item{appDir}{Directory containing the application.}
}
\value{
Returns a list containing the following elements:
\itemize{
\item \code{totalFiles}: Total number of files.
\item \code{totalSize}: Total size of the files (in bytes).
\item \code{contents}: Paths to bundle, relative to \code{appDir}.
}
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}}
\code{listBundleFiles()} has been superseded in favour of \code{\link[=listDeploymentFiles]{listDeploymentFiles()}}.
Given a directory containing an application, returns the names of the files
that by default will be bundled in the application. It works similarly to
a recursive directory listing from \code{\link[=list.files]{list.files()}} but enforces bundle sizes
as described in \code{\link[=listDeploymentFiles]{listDeploymentFiles()}}
}
\keyword{internal}
rsconnect/man/setAccountInfo.Rd 0000644 0001762 0000144 00000001457 14513230050 016236 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/accounts.R
\name{setAccountInfo}
\alias{setAccountInfo}
\title{Register account on shinyapps.io or posit.cloud}
\usage{
setAccountInfo(name, token, secret, server = "shinyapps.io")
}
\arguments{
\item{name}{Name of account to save or remove}
\item{token}{User token for the account}
\item{secret}{User secret for the account}
\item{server}{Server to associate account with.}
}
\description{
Configure a ShinyApps or Posit Cloud account for publishing from this system.
}
\examples{
\dontrun{
# register an account
setAccountInfo("user", "token", "secret")
# remove the same account
removeAccount("user")
}
}
\seealso{
Other Account functions:
\code{\link{accounts}()},
\code{\link{connectApiUser}()}
}
\concept{Account functions}
rsconnect/man/showUsers.Rd 0000644 0001762 0000144 00000001633 14513230050 015310 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/auth.R
\name{showUsers}
\alias{showUsers}
\title{List authorized users for an application}
\usage{
showUsers(appDir = getwd(), appName = NULL, account = NULL, server = NULL)
}
\arguments{
\item{appDir}{Directory containing application. Defaults to
current working directory.}
\item{appName}{Name of application.}
\item{account, server}{Uniquely identify a remote server with either your
user \code{account}, the \code{server} name, or both. If neither are supplied, and
there are multiple options, you'll be prompted to pick one.
Use \code{\link[=accounts]{accounts()}} to see the full list of available options.}
}
\description{
List authorized users for an application
}
\note{
This function works only for ShinyApps servers.
}
\seealso{
\code{\link[=addAuthorizedUser]{addAuthorizedUser()}} and \code{\link[=showInvited]{showInvited()}}
}
rsconnect/man/showLogs.Rd 0000644 0001762 0000144 00000002464 14435652570 015140 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/applications.R
\name{showLogs}
\alias{showLogs}
\title{Show Application Logs}
\usage{
showLogs(
appPath = getwd(),
appFile = NULL,
appName = NULL,
account = NULL,
server = NULL,
entries = 50,
streaming = FALSE
)
}
\arguments{
\item{appPath}{The path to the directory or file that was deployed.}
\item{appFile}{The path to the R source file that contains the application
(for single file applications).}
\item{appName}{The name of the application to show logs for. May be omitted
if only one application deployment was made from \code{appPath}.}
\item{account}{The account under which the application was deployed. May be
omitted if only one account is registered on the system.}
\item{server}{Server name. Required only if you use the same account name on
multiple servers.}
\item{entries}{The number of log entries to show. Defaults to 50 entries.}
\item{streaming}{Whether to stream the logs. If \code{TRUE}, then the
function does not return; instead, log entries are written to the console
as they are made, until R is interrupted. Defaults to \code{FALSE}.}
}
\description{
Show the logs for a deployed ShinyApps application.
}
\note{
This function only uses the \code{libcurl} transport, and works only for
ShinyApps servers.
}
rsconnect/man/deployments.Rd 0000644 0001762 0000144 00000003510 14513230050 015645 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deployments.R
\name{deployments}
\alias{deployments}
\title{List Application Deployments}
\usage{
deployments(
appPath = ".",
nameFilter = NULL,
accountFilter = NULL,
serverFilter = NULL,
excludeOrphaned = TRUE
)
}
\arguments{
\item{appPath}{The path to the content that was deployed, either a directory
or an individual document.}
\item{nameFilter}{Return only deployments matching the given name (optional)}
\item{accountFilter}{Return only deployments matching the given account
(optional)}
\item{serverFilter}{Return only deployments matching the given server
(optional)}
\item{excludeOrphaned}{If \code{TRUE} (the default), return only deployments
made by a currently registered account. Deployments made from accounts that
are no longer registered (via e.g.\code{\link[=removeAccount]{removeAccount()}}) will not be
returned.}
}
\value{
Returns a data frame with at least following columns:
\tabular{ll}{
\code{name} \tab Name of deployed application\cr
\code{account} \tab Account owning deployed application\cr
\code{bundleId} \tab Identifier of deployed application's bundle\cr
\code{url} \tab URL of deployed application\cr
\code{deploymentFile} \tab Name of configuration file\cr
}
If additional metadata has been saved with the deployment record using the
\code{metadata} argument to \code{\link[=deployApp]{deployApp()}}, the frame will include
additional columns.
}
\description{
List deployment records for a given application.
}
\examples{
\dontrun{
# Return all deployments of the ~/r/myapp directory made with the 'abc'
# account
deployments("~/r/myapp", accountFilter="abc")
}
}
\seealso{
\code{\link[=applications]{applications()}} to get a list of deployments from the
server, and \code{\link[=deployApp]{deployApp()}} to create a new deployment.
}
rsconnect/man/rsconnectProxies.Rd 0000644 0001762 0000144 00000000402 14513230050 016647 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/rsconnect-package.R
\name{rsconnectProxies}
\alias{rsconnectProxies}
\title{HTTP Proxy Configuration}
\description{
Please see \code{vignette("custom-http")}.
}
\keyword{internal}
rsconnect/DESCRIPTION 0000644 0001762 0000144 00000003214 14536742742 013774 0 ustar ligges users Type: Package
Package: rsconnect
Title: Deploy Docs, Apps, and APIs to 'Posit Connect', 'shinyapps.io',
and 'RPubs'
Version: 1.2.0
Authors@R: c(
person("Aron", "Atkins", , "aron@posit.co", role = c("aut", "cre")),
person("Toph", "Allen", role = "aut"),
person("Hadley", "Wickham", role = "aut"),
person("Jonathan", "McPherson", role = "aut"),
person("JJ", "Allaire", role = "aut"),
person("Posit Software, PBC", role = c("cph", "fnd"))
)
Description: Programmatic deployment interface for 'RPubs',
'shinyapps.io', and 'Posit Connect'. Supported content types include R
Markdown documents, Shiny applications, Plumber APIs, plots, and
static web content.
License: GPL-2
URL: https://github.com/rstudio/rsconnect
BugReports: https://github.com/rstudio/rsconnect/issues
Depends: R (>= 3.5.0)
Imports: cli, curl, digest, jsonlite, lifecycle, openssl (>= 2.0.0),
packrat (>= 0.6), renv (>= 1.0.0), rlang (>= 1.0.0), rstudioapi
(>= 0.5), tools, yaml (>= 2.1.5)
Suggests: Biobase, BiocManager, foreign, knitr, MASS, plumber (>=
0.3.2), quarto, RCurl, reticulate, rmarkdown (>= 1.1), shiny,
testthat (>= 3.1.9), webfakes, withr
VignetteBuilder: knitr
Config/Needs/website: tidyverse/tidytemplate
Config/testthat/edition: 3
Config/testthat/parallel: true
Encoding: UTF-8
RoxygenNote: 7.2.3
NeedsCompilation: no
Packaged: 2023-12-14 22:20:58 UTC; aron
Author: Aron Atkins [aut, cre],
Toph Allen [aut],
Hadley Wickham [aut],
Jonathan McPherson [aut],
JJ Allaire [aut],
Posit Software, PBC [cph, fnd]
Maintainer: Aron Atkins
Repository: CRAN
Date/Publication: 2023-12-15 03:20:02 UTC
rsconnect/build/ 0000755 0001762 0000144 00000000000 14536677711 013370 5 ustar ligges users rsconnect/build/vignette.rds 0000644 0001762 0000144 00000000333 14536677711 015726 0 ustar ligges users b```b`afd`b2 1# 'O.-.()) MAtKgg+x()@6'$7M E@5/17vԂԼ?iN,/AQU▙
7$apq2݀a>9`~B MI,F(WJbI^ZP? rsconnect/tests/ 0000755 0001762 0000144 00000000000 14513230050 013403 5 ustar ligges users rsconnect/tests/testthat/ 0000755 0001762 0000144 00000000000 14536742742 015270 5 ustar ligges users rsconnect/tests/testthat/shinyapp-with-absolute-paths/ 0000755 0001762 0000144 00000000000 14513230050 023000 5 ustar ligges users rsconnect/tests/testthat/shinyapp-with-absolute-paths/ShinyDocument.Rmd 0000644 0001762 0000144 00000004075 14467166424 026270 0 ustar ligges users ---
title: "Shiny Document"
author: "Phoenix Wright"
date: "July 16, 2014"
output: html_document
runtime: shiny
---
This R Markdown document is made interactive using Shiny. Unlike the more traditional workflow of creating static reports, you can now create documents that allow your readers to change the assumptions underlying your analysis and see the results immediately.
To learn more, see [Interative Documents](http://rmarkdown.rstudio.com/authoring_shiny.html).
## Inputs and Outputs
You can embed Shiny inputs and outputs in your document. Outputs are automatically updated whenever inputs change. This demonstrates how a standard R plot can be made interactive by wrapping it in the Shiny `renderPlot` function. The `selectInput` and `sliderInput` functions create the input widgets used to drive the plot.
```{r, echo=FALSE}
inputPanel(
selectInput("n_breaks", label = "Number of bins:",
choices = c(10, 20, 35, 50), selected = 20),
sliderInput("bw_adjust", label = "Bandwidth adjustment:",
min = 0.2, max = 2, value = 1, step = 0.2)
)
renderPlot({
hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(input$n_breaks),
xlab = "Duration (minutes)", main = "Geyser eruption duration")
dens <- density(faithful$eruptions, adjust = input$bw_adjust)
lines(dens, col = "blue")
})
```
## Embedded Application
It's also possible to embed an entire Shiny application within an R Markdown document using the `shinyAppDir` function. This example embeds a Shiny application located in another directory:
```{r, echo=FALSE}
shinyAppDir(
file.path("~/home/file.txt"),
options = list(
width = "100%", height = 550
)
)
```
Note the use of the `height` parameter to determine how much vertical space the embedded application should occupy.
You can also use the `shinyApp` function to define an application inline rather then in an external directory.
In all of R code chunks above the `echo = FALSE` attribute is used. This is to prevent the R code within the chunk from rendering in the document alongside the Shiny components.
rsconnect/tests/testthat/shinyapp-with-absolute-paths/data/ 0000755 0001762 0000144 00000000000 14513230050 023711 5 ustar ligges users rsconnect/tests/testthat/shinyapp-with-absolute-paths/data/College.txt 0000644 0001762 0000144 00000000015 14513230050 026020 0 ustar ligges users fake,42,data
rsconnect/tests/testthat/shinyapp-with-absolute-paths/server.R 0000644 0001762 0000144 00000002061 14513230050 024430 0 ustar ligges users
# This is the server logic for a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com
#
library(shiny)
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
# read a file on disk
otherFile <- read.table("~/.rsconnect-tests/local-file.txt")
anotherFile <- readLines("../../foo.bar")
serverFile <- "\\\\server\\path\\to\\file"
validWeblink <- "//www.google.com/"
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# don't warn on this line
text <- paste0("x:", round(new_row$x, 2), " y:", round(new_row$y, 2))
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = "darkgray", border = "white")
## read a csv file
file <- read.csv("data/college.txt") ## bad
file <- read.csv("data/College.txt") ## okay
## don't warn about absolute paths that could be URL query paths
file <- paste("/applcations")
})
})
rsconnect/tests/testthat/shinyapp-with-absolute-paths/ui.R 0000644 0001762 0000144 00000001233 14467166424 023564 0 ustar ligges users
# This is the user-interface definition of a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com
#
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Some image
img(src = "/images/icon.png"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
))
rsconnect/tests/testthat/shinyapp-with-absolute-paths/ShinyPresentation.Rmd 0000644 0001762 0000144 00000002306 14467166424 027160 0 ustar ligges users ---
title: "Shiny Presentation"
author: "Miles Edgeworth"
date: "July 16, 2014"
output: ioslides_presentation
runtime: shiny
---
## Shiny Presentation
This R Markdown presentation is made interactive using Shiny. The viewers of the presentation can change the assumptions underlying what's presented and see the results immediately.
To learn more, see [Interative Documents](http://rmarkdown.rstudio.com/authoring_shiny.html).
Here's some internal help: [Helpful Link](/Users/MrBurns/)
And another: [Favourite Goats](../../goats.txt)
## Slide with Interactive Plot
```{r, echo=FALSE}
inputPanel(
selectInput("n_breaks", label = "Number of bins:",
choices = c(10, 20, 35, 50), selected = 20),
sliderInput("bw_adjust", label = "Bandwidth adjustment:",
min = 0.2, max = 2, value = 1, step = 0.2)
)
renderPlot({
hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(input$n_breaks),
xlab = "Duration (minutes)", main = "Geyser eruption duration")
dens <- density(faithful$eruptions, adjust = input$bw_adjust)
lines(dens, col = "blue")
})
```
## Slide with Bullets
- Bullet 1
- Bullet 2
- Bullet 3
## Slide with R Code and Output
```{r}
summary(cars)
```
rsconnect/tests/testthat/test-http-curl.R 0000644 0001762 0000144 00000000416 14513230050 020266 0 ustar ligges users test_that("basic HTTP methods work", {
skip_if(Sys.which("curl") == "")
withr::local_options(rsconnect.http = "curl", lifecycle_verbosity = "quiet")
test_http_GET()
test_http_POST_JSON()
test_http_POST_empty()
test_http_POST_file()
test_http_headers()
})
rsconnect/tests/testthat/test-http-libcurl.R 0000644 0001762 0000144 00000002564 14513230050 020763 0 ustar ligges users test_that("basic HTTP methods work", {
withr::local_options(rsconnect.http = "libcurl")
test_http_GET()
test_http_POST_JSON()
test_http_POST_empty()
test_http_POST_file()
test_http_headers()
})
test_that("can trace JSON", {
withr::local_options(rsconnect.http.trace.json = TRUE)
service <- httpbin_service()
json_app <- webfakes::new_app()
json_app$use(webfakes::mw_json())
json_app$post("/", function(req, res) {
res$set_status(200L)$send_json(req$json)
})
app <- webfakes::new_app_process(json_app)
service <- parseHttpUrl(app$url())
expect_snapshot({
. <- POST_JSON(service, list(), "", list(a = 1, b = 2))
})
})
test_that("can get and set cookies", {
skip_on_cran()
# uses live httpbin since webfakes doesn't support cookie endpoints
service <- parseHttpUrl("http://httpbin.org/")
# Setting
skip_on_http_failure(GET(service, list(), "cookies/set", query = "a=1"))
cookies <- getCookies(service$host)
expect_equal(cookies$name, "a")
expect_equal(cookies$value, "1")
# Overwriting
skip_on_http_failure(GET(service, list(), "cookies/set", query = "a=2&b=1"))
cookies <- getCookies(service$host)
expect_equal(cookies$name, c("b", "a"))
expect_equal(cookies$value, c("1", "2"))
# Preserved across calls
skip_on_http_failure(out <- GET(service, list(), "cookies"))
expect_equal(out$cookies, list(a = "2", b = "1"))
})
rsconnect/tests/testthat/test-rmds/ 0000755 0001762 0000144 00000000000 14536673165 017214 5 ustar ligges users rsconnect/tests/testthat/test-rmds/simple.Rmd 0000644 0001762 0000144 00000000104 14467166424 021142 0 ustar ligges users ---
title: Simple R Markdown document
---
R Markdown is so simple.
rsconnect/tests/testthat/test-rmds/parameterized.Rmd 0000644 0001762 0000144 00000000150 14467166424 022506 0 ustar ligges users ---
title: Parameterized R Markdown document
params:
color: red
---
Parameters are `r params$color`.
rsconnect/tests/testthat/test-rmds/index.Rmd 0000644 0001762 0000144 00000000141 14467166424 020761 0 ustar ligges users ---
title: The index R Markdown document
---
For those times that you do not specify a primary.
rsconnect/tests/testthat/quarto-proj-r-shiny/ 0000755 0001762 0000144 00000000000 14536673156 021144 5 ustar ligges users rsconnect/tests/testthat/quarto-proj-r-shiny/_quarto.yml 0000644 0001762 0000144 00000000071 14467166424 023335 0 ustar ligges users project:
title: "quarto-proj-r-shiny"
editor: visual
rsconnect/tests/testthat/quarto-proj-r-shiny/quarto-proj-r-shiny.qmd 0000644 0001762 0000144 00000001767 14536670534 025531 0 ustar ligges users ---
title: "quarto-proj-r-shiny"
resource_files:
- _quarto.yml
format:
html:
page-layout: custom
server: shiny
---
# "Iris K-Means Clustering"
This example is taken from the [Quarto website](https://quarto.org/docs/interactive/shiny/).
```{r}
#| panel: sidebar
vars <- setdiff(names(iris), "Species")
selectInput("xcol", "X Variable", vars)
selectInput("ycol", "Y Variable", vars, selected = vars[[2]])
numericInput("clusters", "Cluster count", 3, min = 1, max = 9)
```
```{r}
#| panel: fill
plotOutput("plot1")
```
```{r}
#| context: server
selectedData <- reactive({
iris[, c(input$xcol, input$ycol)]
})
clusters <- reactive({
kmeans(selectedData(), input$clusters)
})
output$plot1 <- renderPlot({
palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
"#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))
par(mar = c(5.1, 4.1, 0, 1))
plot(selectedData(),
col = clusters()$cluster,
pch = 20, cex = 3)
points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
})
```
rsconnect/tests/testthat/test-appMetadata-quarto.R 0000644 0001762 0000144 00000005435 14513230050 022104 0 ustar ligges users
# quarto ------------------------------------------------------------------
fakeQuartoMetadata <- function(version, engines) {
# See quarto-r/R/publish.R lines 396 and 113.
metadata <- list()
metadata$quarto_version <- version
metadata$quarto_engines <- I(engines)
return(metadata)
}
test_that("inferQuartoInfo correctly detects info when quarto is provided alone", {
skip_if_no_quarto()
quartoInfo <- inferQuartoInfo(
metadata = list(),
appDir = test_path("quarto-doc-none"),
appPrimaryDoc = "quarto-doc-none.qmd"
)
expect_named(quartoInfo, c("version", "engines"))
expect_equal(quartoInfo$engines, I(c("markdown")))
quartoInfo <- inferQuartoInfo(
appDir = test_path("quarto-website-r"),
appPrimaryDoc = NULL,
metadata = list()
)
expect_named(quartoInfo, c("version", "engines"))
expect_equal(quartoInfo$engines, I(c("knitr")))
})
test_that("inferQuartoInfo extracts info from metadata", {
metadata <- fakeQuartoMetadata(version = "99.9.9", engines = c("internal-combustion"))
quartoInfo <- inferQuartoInfo(
appDir = test_path("quarto-website-r"),
appPrimaryDoc = NULL,
metadata = metadata
)
expect_equal(quartoInfo, list(
version = "99.9.9",
engines = I("internal-combustion")
))
})
test_that("inferQuartoInfo prefers using metadata over quarto inspect", {
skip_if_no_quarto()
metadata <- fakeQuartoMetadata(version = "99.9.9", engines = c("internal-combustion"))
quartoInfo <- inferQuartoInfo(
appDir = test_path("quarto-website-r"),
appPrimaryDoc = NULL,
metadata = metadata
)
expect_equal(quartoInfo$engines, I(c("internal-combustion")))
})
test_that("inferQuartoInfo returns NULL for non-quarto content", {
skip_if_no_quarto()
quartoInfo <- inferQuartoInfo(
appDir = test_path("shinyapp-simple"),
appPrimaryDoc = NULL,
metadata = list()
)
expect_null(quartoInfo)
})
test_that("quartoInspect requires quarto", {
local_mocked_bindings(quarto_path = function() NULL)
expect_snapshot(error = TRUE, {
quartoInspect()
})
})
test_that("quartoInspect identifies on Quarto projects", {
skip_if_no_quarto()
inspect <- quartoInspect(test_path("quarto-website-r"))
expect_true(all(c("quarto", "engines") %in% names(inspect)))
inspect <- quartoInspect(test_path("quarto-proj-r-shiny"))
expect_true(all(c("quarto", "engines") %in% names(inspect)))
})
test_that("quartoInspect identifies Quarto documents", {
skip_if_no_quarto()
inspect <- quartoInspect(
appDir = test_path("quarto-doc-none"),
appPrimaryDoc = "quarto-doc-none.qmd"
)
expect_true(all(c("quarto", "engines") %in% names(inspect)))
})
test_that("quartoInspect returns NULL on non-quarto Quarto content", {
skip_if_no_quarto()
inspect <- quartoInspect(test_path("shinyapp-simple"))
expect_null(inspect)
})
rsconnect/tests/testthat/test-http-internal.R 0000644 0001762 0000144 00000000357 14513230050 021141 0 ustar ligges users test_that("basic HTTP methods work", {
withr::local_options(rsconnect.http = "internal", lifecycle_verbosity = "quiet")
test_http_GET()
test_http_POST_JSON()
test_http_POST_empty()
test_http_POST_file()
test_http_headers()
})
rsconnect/tests/testthat/quarto-website-py/ 0000755 0001762 0000144 00000000000 14536673162 020670 5 ustar ligges users rsconnect/tests/testthat/quarto-website-py/_quarto.yml 0000644 0001762 0000144 00000000360 14467166424 023065 0 ustar ligges users project:
type: website
website:
title: "quarto-website-py"
navbar:
background: primary
left:
- href: index.qmd
text: Home
- about.qmd
format:
html:
theme: cosmo
css: styles.css
editor: visual
rsconnect/tests/testthat/quarto-website-py/styles.css 0000644 0001762 0000144 00000000021 14467166424 022717 0 ustar ligges users /* css styles */
rsconnect/tests/testthat/quarto-website-py/index.qmd 0000644 0001762 0000144 00000000265 14467166424 022506 0 ustar ligges users ---
title: "quarto-website-py"
jupyter: python3
---
This is a Quarto website.
To learn more about Quarto websites visit .
```{python}
1 + 1
```
rsconnect/tests/testthat/quarto-website-py/about.qmd 0000644 0001762 0000144 00000000120 14467166424 022477 0 ustar ligges users ---
title: "About"
jupyter: python3
---
About this site
```{python}
1 + 1
```
rsconnect/tests/testthat/quarto-website-py/requirements.txt 0000644 0001762 0000144 00000000010 14467166424 024144 0 ustar ligges users jupyter
rsconnect/tests/testthat/test-linters.R 0000644 0001762 0000144 00000003364 14513230050 020031 0 ustar ligges users test_that("linter warns about absolute paths and relative paths", {
dirCreate("~/.rsconnect-tests")
file.create("~/.rsconnect-tests/local-file.txt")
withr::defer(unlink("~/.rsconnect-tests", recursive = TRUE))
result <- lint(test_path("shinyapp-with-absolute-paths"))
expect_snapshot(result)
absPathLintedIndices <- result[["server.R"]]$absolute.paths$indices
expect_identical(as.numeric(absPathLintedIndices), 15)
})
test_that("The linter identifies files not matching in case sensitivity", {
result <- lint(test_path("shinyapp-with-absolute-paths"))
server.R <- result[["server.R"]]
filepath.capitalization <- server.R[["filepath.capitalization"]]
expect_equal(as.integer(filepath.capitalization$indices), 31)
})
test_that("The linter identifies files with Markdown links not matching in case sensitivity", {
result <- lint(test_path("test-rmd-bad-case"))
index.Rmd <- result[["index.Rmd"]]
filepath.capitalization <- index.Rmd[["filepath.capitalization"]]
expect_equal(as.integer(filepath.capitalization$indices), 29)
})
test_that("The linter identifies browser() statements correctly", {
result <- lint("shinyapp-with-browser")
server.R <- result[["server.R"]]
browseLines <- server.R[["browser"]]
expect_true(browseLines$indices == 9)
})
test_that("The linter identifies browseURL() statements correctly", {
result <- lint("shinyapp-with-browser")
server.R <- result[["server.R"]]
browseLines <- server.R[["browseURL"]]
expect_true(browseLines$indices == 5)
})
test_that("The linter accepts a plumber API", {
result <- lint("test-plumber")
expect_false(is.null(result$plumber.R))
})
test_that("Linters can run on files with multibyte characters", {
lint("multibyte-characters")
expect_true(TRUE) # didn't stop
})
rsconnect/tests/testthat/test-appDependencies.R 0000644 0001762 0000144 00000005635 14513230050 021443 0 ustar ligges users test_that("appDependencies includes implicit deps", {
skip_on_cran()
withr::local_options(renv.verbose = TRUE)
path <- local_temp_app(list("test.Rmd" = ""))
deps <- appDependencies(path)
expect_true("rmarkdown" %in% deps$Package)
})
test_that("appDependencies includes implicit deps when appMode forced", {
skip_on_cran()
withr::local_options(renv.verbose = TRUE)
dir <- local_temp_app(list(
"app.R" = "",
"plumber.R" = "",
"report.Rmd" = "",
"index.html" = ""
))
files <- c("app.R", "plumber.R", "report.Rmd", "index.html")
# unless forced to "static", the presence of *.Rmd forces rmarkdown as an R
# dependency, regardless of appMode.
# inference indicates a Plumber API.
deps <- appDependencies(dir)
expect_true("plumber" %in% deps$Package)
expect_false("shiny" %in% deps$Package)
expect_true("rmarkdown" %in% deps$Package)
deps <- appDependencies(dir, appMode = "api")
expect_true("plumber" %in% deps$Package)
expect_false("shiny" %in% deps$Package)
expect_true("rmarkdown" %in% deps$Package)
deps <- appDependencies(dir, appMode = "shiny")
expect_false("plumber" %in% deps$Package)
expect_true("shiny" %in% deps$Package)
expect_true("rmarkdown" %in% deps$Package)
deps <- appDependencies(dir, appMode = "rmd-static")
expect_false("plumber" %in% deps$Package)
expect_false("shiny" %in% deps$Package)
expect_true("rmarkdown" %in% deps$Package)
deps <- appDependencies(dir, appMode = "static")
expect_equal(deps, data.frame(
Package = character(),
Version = character(),
Source = character(),
Repository = character(),
stringsAsFactors = FALSE
))
})
test_that("static project doesn't have deps", {
skip_on_cran()
path <- local_temp_app(list("index.html" = ""))
deps <- appDependencies(path)
expect_equal(deps, data.frame(
Package = character(),
Version = character(),
Source = character(),
Repository = character(),
stringsAsFactors = FALSE
))
})
test_that("infers correct packages for each source", {
skip_on_cran()
simulateMetadata <- function(appMode,
hasParameters = FALSE,
documentsHavePython = FALSE) {
list(
appMode = appMode,
hasParameters = hasParameters,
documentsHavePython = documentsHavePython
)
}
# Simple regression test in preparation for refactoring
expect_snapshot({
inferRPackageDependencies(simulateMetadata("rmd-static"))
inferRPackageDependencies(simulateMetadata("rmd-static", hasParameters = TRUE))
inferRPackageDependencies(simulateMetadata("quarto-static"))
inferRPackageDependencies(simulateMetadata("quarto-shiny"))
inferRPackageDependencies(simulateMetadata("rmd-shiny"))
inferRPackageDependencies(simulateMetadata("shiny"))
inferRPackageDependencies(simulateMetadata("api"))
inferRPackageDependencies(simulateMetadata("api", documentsHavePython = TRUE))
})
})
rsconnect/tests/testthat/test-appMetadata.R 0000644 0001762 0000144 00000022575 14513230050 020577 0 ustar ligges users # appMetadata -------------------------------------------------------------
test_that("quarto affects mode inference", {
dir <- local_temp_app(list("foo.Rmd" = ""))
metadata <- appMetadata(dir, c("foo.Rmd"))
expect_equal(metadata$appMode, "rmd-static")
metadata <- appMetadata(dir, c("foo.Rmd"), metadata = list(quarto_version = 1))
expect_equal(metadata$appMode, "quarto-static")
})
test_that("quarto path is deprecated", {
skip_if_no_quarto()
dir <- local_temp_app(list("foo.Rmd" = ""))
expect_snapshot(. <- appMetadata(dir, c("foo.Rmd"), quarto = "abc"))
})
test_that("validates quarto argument", {
dir <- local_temp_app(list("foo.Rmd" = ""))
expect_snapshot(appMetadata(dir, c("foo.Rmd"), quarto = 1), error = TRUE)
})
test_that("handles special case of appPrimaryDoc as R file", {
dir <- local_temp_app(list("foo.R" = ""))
metadata <- appMetadata(dir, c("foo.R"), appPrimaryDoc = "foo.R")
expect_equal(metadata$appMode, "shiny")
})
# https://github.com/rstudio/rsconnect/issues/942
test_that("files beneath the root are not ignored when determining app-mode", {
dir <- local_temp_app(list("app.R" = "", "plumber/api/plumber.R" = ""))
metadata <- appMetadata(dir, c("app.R", "plumber/api/plumber.R"))
expect_equal(metadata$appMode, "shiny")
})
test_that("content type (appMode) is inferred and can be overridden", {
dir <- local_temp_app(list(
"app.R" = "",
"plumber.R" = "",
"report.Rmd" = "",
"index.html" = ""
))
files <- c("app.R", "plumber.R", "report.Rmd", "index.html")
metadata <- appMetadata(dir, files)
expect_equal(metadata$appMode, "api")
metadata <- appMetadata(dir, files, appMode = "shiny")
expect_equal(metadata$appMode, "shiny")
metadata <- appMetadata(dir, files, appMode = "rmd-static")
expect_equal(metadata$appMode, "rmd-static")
metadata <- appMetadata(dir, files, appMode = "static")
expect_equal(metadata$appMode, "static")
})
# checkLayout -------------------------------------------------------------
test_that("checkLayout() errors if primary doc & app.R", {
dir <- local_temp_app(list(
"app.R" = "",
"myscript.R" = ""
))
expect_snapshot(checkAppLayout(dir, appPrimaryDoc = "myscript.R"), error = TRUE)
})
test_that("checkLayout succeeds with some common app structures", {
rmd <- local_temp_app(list("foo.Rmd" = ""))
expect_no_error(checkAppLayout(rmd))
qmd <- local_temp_app(list("foo.qmd" = ""))
expect_no_error(checkAppLayout(qmd))
# perhaps script.R is a pre-render script that generates *.qmd
project <- local_temp_app(list("_quarto.yml" = "", "script.R" = ""))
expect_no_error(checkAppLayout(project))
md <- local_temp_app(list("_quarto.yml" = "", "index.md" = ""))
expect_no_error(checkAppLayout(md))
shiny1 <- local_temp_app(list("app.R" = ""))
expect_no_error(checkAppLayout(shiny1))
shiny2 <- local_temp_app(list("server.R" = "", "ui.R" = ""))
expect_no_error(checkAppLayout(shiny2))
api <- local_temp_app(list("plumber.R" = ""))
expect_no_error(checkAppLayout(api))
static <- local_temp_app(list("foo.html" = ""))
expect_no_error(checkAppLayout(static))
staticxml <- local_temp_app(list("data.xml" = ""))
expect_no_error(checkAppLayout(staticxml))
staticdata <- local_temp_app(list(
"data.txt" = "",
"cats.csv" = ""
))
expect_no_error(checkAppLayout(staticdata))
})
# inferAppMode ------------------------------------------------------------
test_that("can infer mode for APIs", {
expect_equal(inferAppMode("plumber.R"), "api")
expect_equal(inferAppMode("entrypoint.R"), "api")
})
test_that("can infer mode for shiny apps", {
expect_equal(inferAppMode("app.R"), "shiny")
expect_equal(inferAppMode("server.R"), "shiny")
})
test_that("can infer mode for static quarto and rmd docs", {
dir <- local_temp_app(list("foo.Rmd" = ""))
paths <- list.files(dir, full.names = TRUE)
expect_equal(inferAppMode(paths), "rmd-static")
expect_equal(inferAppMode(paths, usesQuarto = TRUE), "quarto-static")
# Static R Markdown treated as rmd-shiny for shinyapps targets
expect_equal(inferAppMode(paths, isShinyappsServer = TRUE), "rmd-shiny")
})
test_that("can infer mode for shiny rmd docs", {
yaml_runtime <- function(runtime) {
c("---", paste0("runtime: ", runtime), "---")
}
dir <- local_temp_app(list("index.Rmd" = yaml_runtime("shiny")))
paths <- list.files(dir, full.names = TRUE)
expect_equal(inferAppMode(paths), "rmd-shiny")
dir <- local_temp_app(list("index.Rmd" = yaml_runtime("shinyrmd")))
paths <- list.files(dir, full.names = TRUE)
expect_equal(inferAppMode(paths), "rmd-shiny")
dir <- local_temp_app(list("index.Rmd" = yaml_runtime("shiny_prerendered")))
paths <- list.files(dir, full.names = TRUE)
expect_equal(inferAppMode(paths), "rmd-shiny")
# can pair server.R with shiny runtime
dir <- local_temp_app(list("index.Rmd" = yaml_runtime("shiny"), "server.R" = ""))
paths <- list.files(dir, full.names = TRUE)
expect_equal(inferAppMode(paths), "rmd-shiny")
# Beats static rmarkdowns
dir <- local_temp_app(list("index.Rmd" = yaml_runtime("shiny"), "foo.Rmd" = ""))
paths <- list.files(dir, full.names = TRUE)
expect_equal(inferAppMode(paths), "rmd-shiny")
})
test_that("can infer mode for shiny qmd docs", {
yaml_runtime <- function(runtime) {
c("---", paste0("runtime: ", runtime), "---")
}
dir <- local_temp_app(list("index.Qmd" = yaml_runtime("shiny")))
paths <- list.files(dir, full.names = TRUE)
expect_equal(inferAppMode(paths), "quarto-shiny")
# Can force Rmd to use quarto
dir <- local_temp_app(list("index.Rmd" = yaml_runtime("shiny")))
paths <- list.files(dir, full.names = TRUE)
expect_equal(inferAppMode(paths, usesQuarto = TRUE), "quarto-shiny")
# Prefers quarto if both present
dir <- local_temp_app(list(
"index.Qmd" = yaml_runtime("shiny"),
"index.Rmd" = yaml_runtime("shiny")
))
paths <- list.files(dir, full.names = TRUE)
expect_equal(inferAppMode(paths), "quarto-shiny")
})
test_that("Shiny R Markdown files are detected correctly", {
expect_true(isShinyRmd(test_path("shiny-rmds/shiny-rmd-dashes.Rmd")))
expect_true(isShinyRmd(test_path("shiny-rmds/shiny-rmd-dots.Rmd")))
expect_false(isShinyRmd(test_path("shiny-rmds/non-shiny-rmd.Rmd")))
})
test_that("shiny metadata process correctly", {
expect_false(is_shiny_prerendered(NULL, NULL))
expect_true(is_shiny_prerendered("shiny_prerendered", NULL))
expect_true(is_shiny_prerendered("shinyrmd", NULL))
expect_true(is_shiny_prerendered(NULL, "shiny"))
expect_true(is_shiny_prerendered(NULL, list(type = "shiny")))
})
test_that("otherwise, fallsback to static deploy", {
expect_equal(inferAppMode(c("a.html", "b.html")), "static")
})
# inferAppPrimaryDoc ------------------------------------------------------
test_that("leaves addPrimaryDoc unchanged or not a document", {
expect_equal(inferAppPrimaryDoc("foo.Rmd"), "foo.Rmd")
expect_equal(inferAppPrimaryDoc(NULL, appMode = "shiny"), NULL)
expect_equal(inferAppPrimaryDoc(NULL, appMode = "api"), NULL)
})
test_that("uses index file if present", {
files <- c("index.html", "index.Rmd", "a.html", "b.html", "a.Rmd", "b.Rmd")
expect_equal(inferAppPrimaryDoc(NULL, files, "static"), "index.html")
expect_equal(inferAppPrimaryDoc(NULL, files, "rmd-shiny"), "index.Rmd")
})
test_that("otherwise fails back to first file with matching extensions", {
files <- c("a.html", "b.html", "a.Rmd", "b.Rmd")
expect_equal(inferAppPrimaryDoc(NULL, files, "static"), "a.html")
expect_equal(inferAppPrimaryDoc(NULL, files, "rmd-shiny"), "a.Rmd")
})
test_that("errors if no files with needed extension", {
expect_snapshot(error = TRUE, {
inferAppPrimaryDoc(NULL, "a.R", "static")
inferAppPrimaryDoc(NULL, "a.R", "rmd-shiny")
})
})
# appHasParameters --------------------------------------------------------
test_that("non-documents don't have parameters", {
dir <- local_temp_app(list("foo.R" = ""))
expect_false(appHasParameters(dir, "foo.R", "static"))
expect_false(appHasParameters(dir, "foo.R", "shiny"))
})
test_that("documents don't have parameters if part of a site", {
dir <- local_temp_app(list("index.Rmd" = c("---", "params: [1, 2]", "---")))
expect_false(appHasParameters(dir, "index.Rmd", "rmd-static", "site"))
expect_false(appHasParameters(dir, "index.Rmd", "qmd-shiny", "site"))
})
test_that("non-Rmd files don't have parameters", {
dir <- local_temp_app(list("app.r" = c("")))
expect_false(appHasParameters(dir, "app.R", "rmd-shiny"))
})
test_that("otherwise look at yaml metadata", {
dir <- local_temp_app(list("index.Rmd" = c("---", "params: [1, 2]", "---")))
expect_true(appHasParameters(dir, "index.Rmd", "rmd-shiny"))
dir <- local_temp_app(list("index.Rmd" = c("---", "params: ~", "---")))
expect_false(appHasParameters(dir, "index.Rmd", "rmd-shiny"))
})
# detectPythonInDocuments -------------------------------------------------
test_that("dir without Rmds doesn't have have python", {
dir <- local_temp_app()
expect_false(detectPythonInDocuments(dir))
dir <- local_temp_app(list("foo.R" = ""))
expect_false(detectPythonInDocuments(dir))
})
test_that("Rmd or qmd with python chunk has python", {
dir <- local_temp_app(list("foo.qmd" = c("```{r}", "1+1", "````")))
expect_false(detectPythonInDocuments(dir))
dir <- local_temp_app(list("foo.Rmd" = c("```{python}", "1+1", "````")))
expect_true(detectPythonInDocuments(dir))
dir <- local_temp_app(list("foo.qmd" = c("```{python}", "1+1", "````")))
expect_true(detectPythonInDocuments(dir))
})
rsconnect/tests/testthat/helper-http.R 0000644 0001762 0000144 00000004001 14513230050 017615 0 ustar ligges users cache <- new_environment()
httpbin_service <- function() {
app <- env_cache(
cache,
"test_app",
webfakes::new_app_process(webfakes::httpbin_app())
)
parseHttpUrl(app$url())
}
strip_port <- function(service) {
function(x) gsub(service$port, "{port}", x)
}
local_cookie_store <- function(env = caller_env()) {
nms <- env_names(.cookieStore)
zaps <- rep_named(nms, list(zap()))
old <- env_bind(.cookieStore, !!!zaps)
withr::defer(env_bind(.cookieStore, !!!old), envir = env)
}
skip_on_http_failure <- function(code) {
tryCatch(
code,
rsconnect_http = function(cnd) {
testthat::skip("http request failed")
}
)
}
# Generic tests of various http methods -----------------------------------
test_http_GET <- function() {
service <- httpbin_service()
# Perform the request
resp <- GET(service, authInfo = NULL, path = "get")
expect_equal(attr(resp, "httpContentType"), "application/json")
expect_equal(resp$path, "/get")
}
test_http_POST_JSON <- function() {
service <- httpbin_service()
body <- list(a = 1, b = 2, c = 3)
resp <- POST_JSON(service, authInfo = NULL, path = "post", json = body)
expect_equal(resp$json, body)
}
test_http_POST_empty <- function() {
service <- httpbin_service()
resp <- POST(service, authInfo = NULL, path = "post")
expect_equal(resp$json, set_names(list()))
}
test_http_POST_file <- function() {
service <- httpbin_service()
path <- withr::local_tempfile()
con <- file(path, "wb")
writeLines(c("1", "2", "3"), con = con)
close(con)
resp <- POST(
service,
authInfo = NULL,
path = "post",
contentType = "text/plain",
file = path
)
expect_equal(resp$data, "1\n2\n3\n")
}
test_http_headers <- function() {
service <- httpbin_service()
resp <- GET(service, authInfo = list(apiKey = "abc123"), path = "get")
expect_equal(resp$headers$Authorization, "Key abc123")
resp <- POST(service, authInfo = list(apiKey = "abc123"), path = "post")
expect_equal(resp$headers$Authorization, "Key abc123")
}
rsconnect/tests/testthat/static-with-quarto-yaml/ 0000755 0001762 0000144 00000000000 14536673165 022003 5 ustar ligges users rsconnect/tests/testthat/static-with-quarto-yaml/_quarto.yml 0000644 0001762 0000144 00000000036 14467166424 024175 0 ustar ligges users project:
title: "slideshow"
rsconnect/tests/testthat/static-with-quarto-yaml/slideshow.html 0000644 0001762 0000144 00000071370 14467166424 024700 0 ustar ligges users
slideshow
slideshow
Quarto
Quarto enables you to weave together content and executable code into a finished presentation. To learn more about Quarto presentations see https://quarto.org/docs/presentations/.
Bullets
When you click the Render button a document will be generated that includes:
Content authored with markdown
Output from executable code
Code
When you click the Render button a presentation will be generated that includes both content and the output of embedded code. You can embed code like this:
[1] 2
rsconnect/tests/testthat/test-plumber/ 0000755 0001762 0000144 00000000000 14467166424 017713 5 ustar ligges users rsconnect/tests/testthat/test-plumber/plumber.R 0000644 0001762 0000144 00000000073 14467166424 021504 0 ustar ligges users
#* @get /foo
fooRoute <- function() {
"hello world"
}
rsconnect/tests/testthat/shiny-app-in-subdir/ 0000755 0001762 0000144 00000000000 14467166424 021072 5 ustar ligges users rsconnect/tests/testthat/shiny-app-in-subdir/my-app/ 0000755 0001762 0000144 00000000000 14513230050 022250 5 ustar ligges users rsconnect/tests/testthat/shiny-app-in-subdir/my-app/server.R 0000644 0001762 0000144 00000000161 14513230050 023677 0 ustar ligges users # Stub server.R
#
# Its presence (along with ui.R) indicates that this directory contains a
# Shiny application.
rsconnect/tests/testthat/shiny-app-in-subdir/my-app/ui.r 0000644 0001762 0000144 00000000161 14513230050 023046 0 ustar ligges users # Stub ui.R
#
# Its presence (along with server.R) indicates that this directory contains a
# Shiny application.
rsconnect/tests/testthat/shinyapp-with-browser/ 0000755 0001762 0000144 00000000000 14467166424 021555 5 ustar ligges users rsconnect/tests/testthat/shinyapp-with-browser/server.R 0000644 0001762 0000144 00000000507 14467166424 023210 0 ustar ligges users library(shiny)
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
# open Google. no reason, just do it
browseURL("https://www.google.com/")
dist <- rnorm(input$obs)
hist(dist)
# stop to examine state
browser()
})
output$obs <- renderText({paste(input$obs, "\n", input$obs)})
})
rsconnect/tests/testthat/shinyapp-with-browser/ui.R 0000644 0001762 0000144 00000000412 14467166424 022312 0 ustar ligges users library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Hello, Shiny!"),
sidebarPanel(
sliderInput("obs", "Number of observations:",
min = 1,
max = 1000,
value = 500)),
mainPanel(
plotOutput("distPlot")))
)
rsconnect/tests/testthat/quarto-website-r-py/ 0000755 0001762 0000144 00000000000 14536673161 021126 5 ustar ligges users rsconnect/tests/testthat/quarto-website-r-py/_quarto.yml 0000644 0001762 0000144 00000000362 14467166424 023326 0 ustar ligges users project:
type: website
website:
title: "quarto-website-r-py"
navbar:
background: primary
left:
- href: index.qmd
text: Home
- about.qmd
format:
html:
theme: cosmo
css: styles.css
editor: visual
rsconnect/tests/testthat/quarto-website-r-py/styles.css 0000644 0001762 0000144 00000000021 14467166424 023156 0 ustar ligges users /* css styles */
rsconnect/tests/testthat/quarto-website-r-py/index.qmd 0000644 0001762 0000144 00000000346 14467166424 022745 0 ustar ligges users ---
title: "quarto-website-r-py"
---
This is a Quarto website.
To learn more about Quarto websites visit .
```{r}
# This is an R chunk
1 + 1
```
```{python}
# This is a Python chunk
1 + 1
```
rsconnect/tests/testthat/quarto-website-r-py/about.qmd 0000644 0001762 0000144 00000000177 14467166424 022752 0 ustar ligges users ---
title: "About"
---
About this site
```{r}
# This is an R chunk
1 + 1
```
```{python}
# This is a Python chunk
1 + 1
```
rsconnect/tests/testthat/quarto-website-r-py/requirements.txt 0000644 0001762 0000144 00000000123 14513230050 024363 0 ustar ligges users # stub requirements.txt
# Its presence indicates the need for Python dependencies.
rsconnect/tests/testthat/test-secret.R 0000644 0001762 0000144 00000000506 14513230050 017631 0 ustar ligges users test_that("NULLs aren't secret", {
expect_equal(secret(NULL), NULL)
})
test_that("print and str obfuscate output", {
expect_snapshot({
x <- secret("THIS IS MY PASSWORD: foo")
x
str(x)
})
})
test_that("can put a secret in a data frame", {
x <- secret("x")
df <- data.frame(x)
expect_equal(df$x, x)
})
rsconnect/tests/testthat/test-config.R 0000644 0001762 0000144 00000001445 14513230050 017614 0 ustar ligges users test_that("account file returned with server name", {
local_temp_config()
registerAccount("simple", "alice", 13, apiKey = "alice-api-key")
expected <- normalizePath(file.path(
rsconnectConfigDir("accounts"),
"simple/alice.dcf"
))
dir <- accountConfigFile("alice", server = "simple")
expect_equal(dir, expected)
})
test_that("account file containing pattern characters found with server name", {
local_temp_config()
registerAccount("complex", "hatter+mad@example.com", 42, apiKey = "hatter-api-key")
# https://github.com/rstudio/rsconnect/issues/620
expected <- normalizePath(file.path(
rsconnectConfigDir("accounts"),
"complex/hatter+mad@example.com.dcf"
))
dir <- accountConfigFile("hatter+mad@example.com", server = "complex")
expect_equal(dir, expected)
})
rsconnect/tests/testthat/multibyte-characters/ 0000755 0001762 0000144 00000000000 14467166424 021423 5 ustar ligges users rsconnect/tests/testthat/multibyte-characters/app.R 0000644 0001762 0000144 00000001236 14467166424 022330 0 ustar ligges users
# 定义用户界面
fluidPage(
# 标题
titlePanel("麻麻再也不用担心我的Shiny应用不能显示中文了"),
# 侧边栏布局
sidebarLayout(
sidebarPanel(
selectInput("dataset", "请选一个数据：",
choices = c("岩石", "pressure", "cars")),
uiOutput("rockvars"),
numericInput("obs", "查看多少行数据？", 5),
checkboxInput("summary", "显示概要", TRUE)
),
# 展示一个HTML表格
mainPanel(
conditionalPanel("input.dataset === '岩石'", plotOutput("rockplot")),
verbatimTextOutput("summary这里也可以用中文"),
tableOutput("view")
)
)
)
rsconnect/tests/testthat/helper-paths.R 0000644 0001762 0000144 00000001062 14513230050 017761 0 ustar ligges users pythonPathOrSkip <- function() {
skip_if_not_installed("reticulate")
if (!reticulate::py_available(TRUE)) {
skip("python not found by reticulate")
}
path <- reticulate::py_config()$python
pipMissing <- system2(path, "-m pip help", stdout = NULL, stderr = NULL)
if (pipMissing != 0) {
skip("pip is not installed")
}
path
}
# quarto ------------------------------------------------------------------
skip_if_no_quarto <- function() {
quarto <- quarto_path()
skip_if(is.null(quarto), "quarto cli is not installed")
invisible()
}
rsconnect/tests/testthat/test-bundle.R 0000644 0001762 0000144 00000015154 14513230050 017622 0 ustar ligges users test_that("simple Shiny app bundle is runnable", {
skip_on_cran()
skip_if_not_installed("shiny")
bundleTempDir <- local_shiny_bundle(
"simple_shiny",
test_path("shinyapp-simple"),
NULL
)
expect_true(inherits(shiny::shinyAppDir(bundleTempDir), "shiny.appobj"))
})
test_that("app.R Shiny app bundle is runnable", {
skip_on_cran()
skip_if_not_installed("shiny")
# shiny:::shinyAppDir() attach shiny so do it here so we can do it quietly
library(shiny, warn.conflicts = FALSE, quietly = TRUE)
bundleTempDir <- local_shiny_bundle(
"app_r_shiny",
test_path("shinyapp-appR"),
NULL
)
expect_true(inherits(shiny::shinyAppDir(bundleTempDir), "shiny.appobj"))
})
test_that("single-file Shiny app bundle is runnable", {
skip_on_cran()
skip_if_not_installed("shiny")
bundleTempDir <- local_shiny_bundle(
"app_r_shiny",
test_path("shinyapp-singleR"),
"single.R"
)
expect_true(inherits(shiny::shinyAppDir(bundleTempDir), "shiny.appobj"))
})
test_that("simple Rmd as primary not identified as parameterized when parameterized Rmd in bundle", {
skip_on_cran()
bundleTempDir <- local_shiny_bundle(
"rmd primary",
test_path("test-rmds"),
"simple.Rmd"
)
manifest <- jsonlite::fromJSON(file.path(bundleTempDir, "manifest.json"))
expect_equal(manifest$metadata$appmode, "rmd-static")
expect_equal(manifest$metadata$primary_rmd, "simple.Rmd")
expect_equal(manifest$metadata$has_parameters, FALSE)
})
test_that("parameterized Rmd identified as parameterized when other Rmd in bundle", {
skip_on_cran()
bundleTempDir <- local_shiny_bundle(
"rmd primary",
test_path("test-rmds"),
"parameterized.Rmd"
)
manifest <- jsonlite::fromJSON(file.path(bundleTempDir, "manifest.json"))
expect_equal(manifest$metadata$appmode, "rmd-static")
expect_equal(manifest$metadata$primary_rmd, "parameterized.Rmd")
expect_equal(manifest$metadata$has_parameters, TRUE)
})
test_that("primary doc can be inferred (and non-parameterized dispite an included parameterized", {
skip_on_cran()
bundleTempDir <- local_shiny_bundle(
"rmd primary",
test_path("test-rmds"),
NULL
)
manifest <- jsonlite::fromJSON(file.path(bundleTempDir, "manifest.json"))
expect_equal(manifest$metadata$appmode, "rmd-static")
expect_equal(manifest$metadata$primary_rmd, "index.Rmd")
expect_equal(manifest$metadata$has_parameters, FALSE)
})
test_that("Rmd with reticulate as a dependency includes python in the manifest", {
skip_on_cran()
skip_if_not_installed("reticulate")
python <- pythonPathOrSkip()
bundleTempDir <- local_shiny_bundle(
"reticulated rmd",
test_path("test-reticulate-rmds"),
NULL,
python = python
)
manifest <- jsonlite::fromJSON(file.path(bundleTempDir, "manifest.json"))
expect_equal(manifest$metadata$appmode, "rmd-static")
expect_equal(manifest$metadata$primary_rmd, "index.Rmd")
expect_true("reticulate" %in% names(manifest$packages))
expect_true(file.exists(file.path(bundleTempDir, manifest$python$package_manager$package_file)))
})
test_that("Rmd with reticulate as an inferred dependency includes reticulate and python in the manifest", {
skip_on_cran()
skip_if_not_installed("reticulate")
python <- pythonPathOrSkip()
bundleTempDir <- local_shiny_bundle(
"reticulated rmd",
test_path("test-reticulate-rmds"),
"implicit.Rmd",
python = python
)
manifest <- jsonlite::fromJSON(file.path(bundleTempDir, "manifest.json"))
expect_equal(manifest$metadata$appmode, "rmd-static")
expect_equal(manifest$metadata$primary_rmd, "implicit.Rmd")
expect_true("reticulate" %in% names(manifest$packages))
expect_true(file.exists(file.path(bundleTempDir, manifest$python$package_manager$package_file)))
})
test_that("Rmd without a python block doesn't include reticulate or python in the manifest", {
skip_on_cran()
bundleTempDir <- local_shiny_bundle(
"plain rmd",
test_path("test-rmds"),
"simple.Rmd",
python = NULL
)
manifest <- jsonlite::fromJSON(file.path(bundleTempDir, "manifest.json"))
expect_equal(manifest$metadata$appmode, "rmd-static")
expect_equal(manifest$metadata$primary_rmd, "simple.Rmd")
expect_false("reticulate" %in% names(manifest$packages))
expect_equal(manifest$python, NULL)
})
test_that("Rmd without a python block doesn't include reticulate or python in the manifest even if python specified", {
skip_on_cran()
skip_if_not_installed("reticulate")
python <- pythonPathOrSkip()
bundleTempDir <- local_shiny_bundle(
"plain rmd",
test_path("test-rmds"),
"simple.Rmd",
python = python
)
manifest <- jsonlite::fromJSON(file.path(bundleTempDir, "manifest.json"))
expect_equal(manifest$metadata$appmode, "rmd-static")
expect_equal(manifest$metadata$primary_rmd, "simple.Rmd")
expect_false("reticulate" %in% names(manifest$packages))
expect_equal(manifest$python, NULL)
})
test_that("tarImplementation: checks environment variable and option before using default", {
tar_implementation <- function(option, envvar) {
withr::local_options(rsconnect.tar = option)
withr::local_envvar(RSCONNECT_TAR = envvar)
getTarImplementation()
}
# Environment variable only set should use environment varaible
expect_equal(tar_implementation(NULL, "envvar"), "envvar")
# Option only set should use option
expect_equal(tar_implementation("option", NA), "option")
# Both environment variable and option set should use option
expect_equal(tar_implementation("option", "envvar"), "option")
# Neither set should use "internal"
expect_equal(tar_implementation(NULL, NA), "internal")
})
# tweakRProfile -----------------------------------------------------------
test_that(".Rprofile tweaked automatically", {
dir <- withr::local_tempdir()
writeLines('source("renv/activate.R")', file.path(dir, ".Rprofile"))
bundled <- bundleAppDir(dir, list.files(dir, all.files = TRUE))
expect_match(
readLines(file.path(bundled, ".Rprofile")),
"Modified by rsconnect",
all = FALSE
)
})
test_that(".Rprofile without renv/packrt left as is", {
lines <- c("1 + 1", "# Line 2", "library(foo)")
path <- withr::local_tempfile(lines = lines)
tweakRProfile(path)
expect_equal(readLines(path), lines)
})
test_that("removes renv/packrat activation", {
path <- withr::local_tempfile(lines = c(
"# Line 1",
'source("renv/activate.R")',
"# Line 3",
'source("packrat/init.R")',
"# Line 5"
))
expect_snapshot(
{
tweakRProfile(path)
writeLines(readLines(path))
},
transform = function(x) {
x <- gsub("on \\d{4}.+", "on ", x)
x <- gsub(packageVersion("rsconnect"), "", x, fixed = TRUE)
x
}
)
})
rsconnect/tests/testthat/test-client-connect.R 0000644 0001762 0000144 00000007273 14513230050 021261 0 ustar ligges users # NOTE: These tests expect that you're already running connect; the tests
# will speak to that running connect process (if it can find it)
findConnect <- function() {
connect <- Sys.which("connect")
if (connect == "") {
possibleLocs <- c(
"~/git/connect/bin"
)
for (loc in possibleLocs) {
if (file.exists(file.path(loc, "connect"))) {
return(normalizePath(file.path(loc, "connect")))
}
}
stop("Couldn't find an appropriate 'connect' binary")
}
}
test_that("Users API", {
skip_on_cran()
skip_on_os("windows")
skip("connect user test skipped.")
## rm db/*.db
server <- serverInfo(findServer())
connect <- connectClient(server$url, list())
id <- paste(as.hexmode(sample(256, bytes) - 1), collapse = "")
# add a user
record <- userRecord(
email = paste0("user", id, "@gmail.com"),
username = paste0("user", id),
first_name = "User",
last_name = "Resu",
password = paste0("password", id)
)
response <- connect$addUser(record)
# check a couple main fields
expect_equal(
response[c("email", "first_name", "last_name", "username")],
list(
email = record$email,
first_name = record$first_name,
last_name = record$last_name,
username = record$username
)
)
# make sure we returned an empty password field (or no password field?)
expect_true(response$password %in% "" || is.null(response$password))
# generate a token
accountId <- response$id
token <- generateToken()
tokenResponse <- connect$addToken(list(token = token$token,
public_key = token$public_key,
user_id = accountId))
Sys.sleep(1)
# open the URL in the browser
utils::browseURL(tokenResponse$token_claim_url)
# Sleep for a second so we can be sure that automatic auth happened
Sys.sleep(2)
# finally, create a fully authenticated client using the new token, and
# keep trying to authenticate until we're successful
connect <- connectClient(service = server$url, authInfo =
list(token = token$token,
private_key = token$private_key))
repeat {
tryCatch({
user <- connect$currentUser()
break
},
error = function(e, ...) {
# we expect this to return unauthorized until the token becomes active,
# but bubble other errors
if (length(grep("401 - Unauthorized", e$message)) == 0) {
stop(e)
}
Sys.sleep(1)
})
}
# Create and remove an example application
## Create it
splineReticulator <- connect$createApplication("SplineReticulator")
# Update the account id (since we have moved from unauthed user
# to authed user)
accountId <- splineReticulator$user_id
## Confirm it exists
apps <- connect$listApplications(accountId)
app <- apps[[which(sapply(apps, `[[`, "id") == splineReticulator$id)]]
expect_true(app$name == "SplineReticulator")
## Upload a bundle
pwd_splat <- strsplit(getwd(), "/")[[1]]
if (pwd_splat[length(pwd_splat)] == "rsconnect") {
path <- "tests/testthat/test-shinyApp/test-shinyApp.tar.gz"
} else {
path <- "test-shinyApp/test-shinyApp.tar.gz"
}
response <- connect$uploadApplication(
splineReticulator$id,
normalizePath(path = path)
)
## Deploy an application
appId <- response$app_id
response <- connect$deployApplication(list(id = appId))
id <- response$id
## Query the app for success / failure
response <- connect$waitForTask(id)
## Terminate the application (does not remove it from store)
connect$terminateApplication(appId)
apps <- connect$listApplications(accountId)
expect_false(response$id %in% sapply(apps, "[[", "id"))
})
rsconnect/tests/testthat/test-client-cloud.R 0000644 0001762 0000144 00000062233 14516247550 020753 0 ustar ligges users mockServerFactory <- function(initialResponses) {
# Stock responses for certain endpoints. Can still be overridden by tests.
if (is.null(initialResponses$"^GET /v1/users/current")) {
initialResponses$"GET /v1/users/current" <- list(
content = list(
id = 100
)
)
}
if (is.null(initialResponses$"^GET /v1/accounts/?")) {
initialResponses$"^GET /v1/accounts/?" <- list(
content = list(
count = 1,
total = 1,
offset = 0,
accounts = list(
list(
id = 50,
name = "testthat-account",
account = "testthat-account"
),
list(
id = 51,
name = "testthat-superfluous-account",
account = "testthat-superfluous-account"
)
)
)
)
}
mockServer <- list(
responses = initialResponses
)
mockServer$addResponse <- function(methodAndPath, response) {
mockServer$responses <- append(mockServer$responses, response)
}
mockServer$impl <- function(protocol,
host,
port,
method,
path,
headers,
contentType = NULL,
contentFile = NULL,
certificate = NULL,
timeout = NULL) {
methodAndPath <- paste(method, path)
request <- list(
protocol = protocol,
host = host,
port = port,
method = method,
path = path
)
response <- list(
req = request,
status = 200,
location = "",
contentType = "application/json"
)
found <- FALSE
for (pathRegex in names(mockServer$responses)) {
match <- regexec(pathRegex, methodAndPath)[[1]]
if (match[1] != -1) {
found <- TRUE
responseSupplement <- mockServer$responses[[pathRegex]]
for (respProperty in names(responseSupplement)) {
if (is.function(responseSupplement[[respProperty]])) {
responseSupplement[[respProperty]] <- responseSupplement[[respProperty]](
methodAndPath,
match,
headers = headers,
contentType = contentType,
contentFile = contentFile)
}
response[[respProperty]] <- responseSupplement[[respProperty]]
}
if (is.list(response$content)) {
response$content <- jsonlite::toJSON(response$content, auto_unbox = TRUE)
}
break
}
}
if (!found) {
stop(paste("No mocked response defined for", methodAndPath))
}
response
}
mockServer
}
configureTestAccount <- function(server = "posit.cloud", name = NULL) {
if (is.null(name)) {
name <- "testthat-account"
}
existingAccount <- NULL
tryCatch(
existingAccount <- accountInfo(name, server),
error = function(e) { existingAccount <- NULL }
)
if (is.null(existingAccount)) {
setAccountInfo(
name = name,
token = "foo",
secret = "bar",
server = server
)
}
name
}
test_that("Get application", {
mockServer <- mockServerFactory(list(
"^GET /outputs/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
output_id <- strtoi(substr(methodAndPath, match[2], end))
if (output_id != 5) {
cli::cli_abort(
"404 error",
class = "rsconnect_http_404"
)
}
list(
"id" = 5,
"source_id" = 10,
"url" = "http://fake-url.test.me/",
"state" = "active"
)
}
),
"^GET /applications/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- strtoi(substr(methodAndPath, match[2], end))
if (application_id != 10) {
cli::cli_abort(
"404 error",
class = "rsconnect_http_404"
)
}
list(
"id" = application_id,
"content_id" = 5
)
}
)
))
withr::local_options(rsconnect.http = mockServer$impl)
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
app <- client$getApplication("10", NA)
expect_equal(app$id, 5)
expect_equal(app$application_id, 10)
expect_equal(app$url, "http://fake-url.test.me/")
app <- client$getApplication("5", 1)
expect_equal(app$id, 5)
expect_equal(app$application_id, 10)
expect_equal(app$url, "http://fake-url.test.me/")
app <- client$getApplication("5", "unknown")
expect_equal(app$id, 5)
expect_equal(app$application_id, 10)
expect_equal(app$url, "http://fake-url.test.me/")
app <- client$getApplication("10", "unknown")
expect_equal(app$id, 5)
expect_equal(app$application_id, 10)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("Get application output trashed", {
mockServer <- mockServerFactory(list(
"^GET /outputs/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
output_id <- strtoi(substr(methodAndPath, match[2], end))
list(
"id" = output_id,
"source_id" = 1,
"url" = "http://fake-url.test.me/",
"state" = "trashed"
)
}
),
"^GET /applications/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- strtoi(substr(methodAndPath, match[2], end))
list(
"id" = application_id,
"content_id" = 5
)
}
),
"^PATCH /outputs/5" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
output_id <- strtoi(substr(methodAndPath, match[2], end))
list()
}
)
))
withr::local_options(rsconnect.http = mockServer$impl)
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
app <- client$getApplication(10, NA)
expect_equal(app$id, 5)
expect_equal(app$application_id, 10)
expect_equal(app$url, "http://fake-url.test.me/")
app <- client$getApplication(5, deploymentRecordVersion)
expect_equal(app$id, 5)
expect_equal(app$application_id, 1)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("Create application", {
mockServer <- mockServerFactory(list(
"^POST /outputs" = list(
content = function(methodAndPath, match, contentFile, ...) {
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$application_type, "connect")
list(
"id" = 1,
"source_id" = 2,
"url" = "http://fake-url.test.me/",
"state" = "active"
)
}
),
"^GET /applications/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- strtoi(substr(methodAndPath, match[2], end))
list(
"id" = application_id,
"content_id" = 1
)
})
))
withr::local_options(rsconnect.http = mockServer$impl)
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
app <- client$createApplication("test app", "unused?", "unused?", "unused?", "shiny")
expect_equal(app$id, 1)
expect_equal(app$application_id, 2)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("Create application with space id", {
mockServer <- mockServerFactory(list(
"^POST /outputs" = list(
content = function(methodAndPath, match, contentFile, ...) {
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$application_type, "connect")
expect_equal(content$space, 333)
list(
"id" = 1,
"source_id" = 2,
"url" = "http://fake-url.test.me/",
"state" = "active"
)
}
),
"^GET /applications/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- strtoi(substr(methodAndPath, match[2], end))
list(
"id" = application_id,
"content_id" = 1
)
})
))
withr::local_options(rsconnect.http = mockServer$impl)
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
app <- client$createApplication("test app", "unused?", "unused?", "unused?", "shiny", spaceId = 333)
expect_equal(app$id, 1)
expect_equal(app$application_id, 2)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("Create static application", {
mockServer <- mockServerFactory(list(
"^POST /outputs" = list(
content = function(methodAndPath, match, contentFile, ...) {
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$application_type, "static")
expect_equal(content$content_category, "document")
list(
"id" = 1,
"source_id" = 2,
"url" = "http://fake-url.test.me/",
"state" = "active"
)
}
),
"^GET /applications/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- strtoi(substr(methodAndPath, match[2], end))
list(
"id" = application_id,
"content_id" = 1
)
})
))
withr::local_options(rsconnect.http = mockServer$impl)
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
app <- client$createApplication("test app", "unused?", "unused?", "unused?", "static", "document")
expect_equal(app$id, 1)
expect_equal(app$application_id, 2)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("Create static server-side-rendered application", {
mockServer <- mockServerFactory(list(
"^POST /outputs" = list(
content = function(methodAndPath, match, contentFile, ...) {
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$application_type, "static")
expect_equal(content$render_by, "server")
expect_equal(content$content_category, "document")
list(
"id" = 1,
"source_id" = 2,
"url" = "http://fake-url.test.me/",
"state" = "active"
)
}
),
"^GET /applications/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- strtoi(substr(methodAndPath, match[2], end))
list(
"id" = application_id,
"content_id" = 1
)
})
))
withr::local_options(rsconnect.http = mockServer$impl)
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
app <- client$createApplication("test app", "unused?", "unused?", "unused?", "quarto-static", "document")
expect_equal(app$id, 1)
expect_equal(app$application_id, 2)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("deployApplication updates the parent project", {
mockServer <- mockServerFactory(list(
"^GET /applications/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- substr(methodAndPath, match[2], end)
expect_equal(application_id, "42")
list(
"id" = 42,
"content_id" = 41
)
}
),
"^PATCH /outputs" = list(
content = function(methodAndPath, match, contentFile, ...) {
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
if (!is.null(content$project)) {
expect_equal(content$project, 41)
} else {
expect_equal(content$space, 333)
}
list(
"id" = 41
)
}
),
"^POST /applications/([0-9]+)/deploy" = list(
content = function(methodAndPath, match, contentFile, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- substr(methodAndPath, match[2], end)
expect_equal(application_id, "101/")
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$rebuild, FALSE)
list(
"id" = 101
)
}
)
))
withr::local_options(rsconnect.http = mockServer$impl)
withr::local_envvar(LUCID_APPLICATION_ID = "42")
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
application <- list(
"id" = 100,
"application_id" = 101
)
client$deployApplication(application, spaceId = 333)
})
test_that("Create static RMD application", {
mockServer <- mockServerFactory(list(
"^POST /outputs" = list(
content = function(methodAndPath, match, contentFile, ...) {
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$application_type, "static")
expect_equal(content$render_by, "server")
expect_equal(content$content_category, "document")
list(
"id" = 1,
"source_id" = 2,
"url" = "http://fake-url.test.me/",
"state" = "active"
)
}
),
"^GET /applications/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- strtoi(substr(methodAndPath, match[2], end))
list(
"id" = application_id,
"content_id" = 1
)
})
))
withr::local_options(rsconnect.http = mockServer$impl)
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
app <- client$createApplication("test app", "unused?", "unused?", "1", "rmd-static", "document")
expect_equal(app$id, 1)
expect_equal(app$application_id, 2)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("Create application with linked source project", {
mockServer <- mockServerFactory(list(
"^POST /outputs" = list(
content = function(methodAndPAth, match, contentFile, ...) {
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$project, 41)
expect_equal(content$space, 99)
list(
"id" = 1,
"source_id" = 2,
"url" = "http://fake-url.test.me/",
"state" = "active"
)
}
),
"^GET /applications/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- strtoi(substr(methodAndPath, match[2], end))
list(
"id" = application_id,
"content_id" = application_id - 1
)
}
),
"^GET /content/41" = list(
content = list(
"id" = 41,
"space_id" = 99
)
)
))
withr::local_options(rsconnect.http = mockServer$impl)
Sys.setenv(LUCID_APPLICATION_ID = "42")
withr::defer(Sys.unsetenv("LUCID_APPLICATION_ID"))
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
app <- client$createApplication("test app", "unused?", "unused?", "unused?", "static")
expect_equal(app$id, 1)
expect_equal(app$application_id, 2)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("findDeploymentTarget() results in correct Cloud API calls when given appId", {
local_temp_config()
mockServer <- mockServerFactory(list(
"^GET /v1/applications/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- strtoi(substr(methodAndPath, match[2], end))
list(
"id" = application_id,
"content_id" = application_id - 1,
"name" = paste("testthat app", application_id)
)
}
),
"^GET /v1/outputs/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
output_id <- strtoi(substr(methodAndPath, match[2], end))
list(
"id" = output_id,
"source_id" = output_id + 1,
"url" = "http://fake-url.test.me/",
"state" = "active",
"name" = "my output"
)
}
)
))
withr::local_options(rsconnect.http = mockServer$impl)
testAccount <- configureTestAccount()
withr::defer(removeAccount(testAccount))
target <- findDeploymentTarget(
appId = 3,
account = testAccount,
server = "posit.cloud",
)
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(deployment$name, "my output")
expect_equal(deployment$account, testAccount)
expect_equal(deployment$server, "posit.cloud")
expect_equal(deployment$appId, 3)
})
deployAppMockServerFactory <- function(expectedAppType, outputState) {
outputResponse <- list(
"id" = 1,
"source_id" = 2,
"url" = "http://fake-url.test.me/",
"state" = outputState
)
actualCalls <- list(
outputCreated = FALSE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = FALSE,
bundleUploaded = FALSE,
bundleReady = FALSE,
deployStarted = FALSE
)
server <- mockServerFactory(list(
# An attempt to search for preexisting applications with the same name.
# This call should change, see https://github.com/rstudio/rsconnect/issues/808
"^GET /v1/applications/[?]filter=account_id:50&filter=type:connect" = list(
content = list(
count = 0,
total = 0,
applications = list()
)
),
"^POST /v1/outputs$" = list(
content = function(methodAndPath, match, contentFile, ...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$outputCreated <- TRUE
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$application_type, expectedAppType)
expect_equal(content$name, "Desired name here")
outputResponse
}
),
"^GET /v1/applications/([0-9]+)$" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- strtoi(substr(methodAndPath, match[2], end))
list(
id = application_id,
content_id = application_id - 1,
name = paste("testthat app", application_id),
type = expectedAppType
)
}
),
"^POST /v1/bundles/123/status$" = list(
content = function(methodAndPath, match, contentFile, ...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$bundleReady <- TRUE
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$status, "ready")
list()
}
),
"^POST /v1/bundles$" = list(
content = function(methodAndPath, match, contentFile, ...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$bundleCreated <- TRUE
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
list(
id = 123,
presigned_url = "https://write-only-memory.com/fake-presigned-url",
presigned_checksum = content$checksum
)
}
),
"^PUT /fake-presigned-url" = list(
content = function(...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$bundleUploaded <- TRUE
}
),
"^GET /v1/bundles/123$" = list(
content = list(
id = 123,
status = "ready"
)
),
"^POST /v1/applications/[23]/deploy$" = list(
content = function(...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$deployStarted <- TRUE
list(
task_id = "testthat-task-id"
)
}
),
"^GET /v1/tasks/testthat-task-id$" = list(
content = list(
status = "success",
finished = TRUE
)
),
# Fetch existing output when re-deploying from .dcf data
"^GET /v1/outputs/1$" = list(
content = outputResponse
),
"^POST /v1/outputs/1/revisions" = list(
content = function(...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$revisionCreated <- TRUE
list(
application_id = 3
)
}
),
"^PATCH /v1/outputs" = list(
content = function(...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$outputStateUpdated <- TRUE
}
)
))
expect_calls <- function(expectedCalls) {
expect_equal(actualCalls, expectedCalls)
}
reset_calls <- function() {
e <- environment()
p <- parent.env(e)
p$actualCalls <- list(
outputCreated = FALSE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = FALSE,
bundleUploaded = FALSE,
bundleReady = FALSE,
deployStarted = FALSE
)
}
list(
server = server,
expect_calls = expect_calls,
reset_calls = reset_calls
)
}
test_that("deployApp() for shiny results in correct Cloud API calls", {
skip_on_cran()
local_temp_config()
withr::local_options(renv.verbose = TRUE)
mock <- deployAppMockServerFactory(expectedAppType = "connect", outputState = "active")
mockServer <- mock$server
withr::local_options(rsconnect.http = mockServer$impl)
testAccount <- configureTestAccount()
withr::defer(removeAccount(testAccount))
sourcePath <- test_path("shinyapp-simple")
# Remove local deployment info at end for reproducibility and tidiness.
withr::defer(forgetDeployment(appPath = sourcePath, force = TRUE))
deployApp(
appName = "Desired name here",
appDir = sourcePath,
server = "posit.cloud",
account = testAccount,
logLevel = "quiet"
)
mock$expect_calls(list(
outputCreated = TRUE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = TRUE,
bundleUploaded = TRUE,
bundleReady = TRUE,
deployStarted = TRUE
))
mock$reset_calls()
# deploy again to test existing deployment path
deployApp(
appDir = sourcePath,
logLevel = "quiet"
)
mock$expect_calls(list(
outputCreated = FALSE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = TRUE,
bundleUploaded = TRUE,
bundleReady = TRUE,
deployStarted = TRUE
))
# Start over, add another posit.cloud account and test again with that environment
mock$reset_calls()
forgetDeployment(appPath = sourcePath, force = TRUE)
extraLocalAccount <- configureTestAccount(name = "testthat-superfluous-account")
withr::defer(removeAccount(extraLocalAccount))
deployApp(
appName = "Desired name here",
appDir = sourcePath,
server = "posit.cloud",
account = testAccount,
logLevel = "quiet"
)
mock$expect_calls(list(
outputCreated = TRUE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = TRUE,
bundleUploaded = TRUE,
bundleReady = TRUE,
deployStarted = TRUE
))
mock$reset_calls()
# deploy again to test existing deployment path
deployApp(
appDir = sourcePath,
logLevel = "quiet"
)
mock$expect_calls(list(
outputCreated = FALSE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = TRUE,
bundleUploaded = TRUE,
bundleReady = TRUE,
deployStarted = TRUE
))
})
test_that("deployDoc() results in correct Cloud API calls", {
local_temp_config()
mock <- deployAppMockServerFactory(expectedAppType = "static", outputState = "active")
mockServer <- mock$server
withr::local_options(rsconnect.http = mockServer$impl)
testAccount <- configureTestAccount()
withr::defer(removeAccount(testAccount))
sourcePath <- test_path("static-with-quarto-yaml")
# Remove local deployment info at end for reproducibility and tidiness.
withr::defer(forgetDeployment(appPath = sourcePath, force = TRUE))
deployDoc(
paste(sourcePath, "slideshow.html", sep = "/"),
appName = "Desired name here",
server = "posit.cloud",
account = testAccount,
logLevel = "quiet"
)
mock$expect_calls(list(
outputCreated = TRUE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = TRUE,
bundleUploaded = TRUE,
bundleReady = TRUE,
deployStarted = TRUE
))
mock$reset_calls()
# deploy again to test existing deployment path
deployApp(
appDir = sourcePath,
logLevel = "quiet"
)
mock$expect_calls(list(
outputCreated = FALSE,
outputStateUpdated = FALSE,
revisionCreated = TRUE,
bundleCreated = TRUE,
bundleUploaded = TRUE,
bundleReady = TRUE,
deployStarted = TRUE
))
})
rsconnect/tests/testthat/shinyapp-appR/ 0000755 0001762 0000144 00000000000 14513230050 017776 5 ustar ligges users rsconnect/tests/testthat/shinyapp-appR/rsconnect/ 0000755 0001762 0000144 00000000000 14513230050 021774 5 ustar ligges users rsconnect/tests/testthat/shinyapp-appR/rsconnect/colorado.posit.co/ 0000755 0001762 0000144 00000000000 14513230050 025333 5 ustar ligges users rsconnect/tests/testthat/shinyapp-appR/rsconnect/colorado.posit.co/hadley/ 0000755 0001762 0000144 00000000000 14513230050 026601 5 ustar ligges users rsconnect/tests/testthat/shinyapp-appR/rsconnect/colorado.posit.co/hadley/shinyapp-appR.dcf 0000644 0001762 0000144 00000000363 14513230050 032014 0 ustar ligges users name: shinyapp-appR
title:
username: hadley
account: hadley
server: colorado.posit.co
hostUrl: https://colorado.posit.co/rsc/__api__
appId: 15717
bundleId: 71906
url: https://colorado.posit.co/rsc/content/87507bba-4a69-4e19-becd-748b9406bad2/
rsconnect/tests/testthat/shinyapp-appR/app.R 0000644 0001762 0000144 00000000565 14467166424 020734 0 ustar ligges users server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = "darkgray", border = "white")
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("obs", "Number of observations:", min = 10, max = 500,
value = 100)),
mainPanel(plotOutput("distPlot"))))
shinyApp(ui = ui, server = server)
rsconnect/tests/testthat/test-bundlePython.R 0000644 0001762 0000144 00000004410 14513230050 021015 0 ustar ligges users test_that("getPython looks in argument, RETICULATE_PYTHON, then RETICULATE_PYTHON_FALLBACK", {
skip_on_cran()
withr::local_envvar(
RETICULATE_PYTHON = "~/python",
RETICULATE_PYTHON_FALLBACK = "~/fallback"
)
expect_equal(getPython("~/supplied"), path.expand("~/supplied"))
expect_equal(getPython(NULL), path.expand("~/python"))
withr::local_envvar(
RETICULATE_PYTHON = NA,
RETICULATE_PYTHON_FALLBACK = "~/fallback"
)
expect_equal(getPython(NULL), path.expand("~/fallback"))
withr::local_envvar(
RETICULATE_PYTHON = NA,
RETICULATE_PYTHON_FALLBACK = NA
)
expect_equal(getPython(NULL), NULL)
})
test_that("rsconnect.python.enabled overrides getPythonForTarget() default", {
skip_on_cran()
expect_equal(getPythonForTarget("p", list(server = "shinyapps.io")), NULL)
expect_equal(getPythonForTarget("p", list(server = "example.com")), "p")
withr::local_options(rsconnect.python.enabled = FALSE)
expect_equal(getPythonForTarget("p", list(server = "shinyapps.io")), NULL)
expect_equal(getPythonForTarget("p", list(server = "example.com")), NULL)
withr::local_options(rsconnect.python.enabled = TRUE)
expect_equal(getPythonForTarget("p", list(server = "shinyapps.io")), "p")
expect_equal(getPythonForTarget("p", list(server = "example.com")), "p")
})
test_that("can infer env from existing directory", {
skip_on_cran()
env <- inferPythonEnv(test_path("test-reticulate-rmds"), pythonPathOrSkip())
expect_named(env, c("version", "package_manager"))
expect_named(env$package_manager, c("name", "version", "package_file", "contents"))
})
test_that("doesn't override existing requirements.txt by default", {
skip_on_cran()
dir <- local_temp_app(list(requirements.txt = "pip"))
env <- inferPythonEnv(dir, pythonPathOrSkip())
expect_equal(env$package_manager$contents, "pip\n")
env <- inferPythonEnv(dir, pythonPathOrSkip(), forceGenerate = TRUE)
expect_match(env$package_manager$contents, "generated by rsconnect-python")
})
test_that("throws error if environment.py fails", {
skip_on_cran()
skip_on_os("windows")
dir <- local_temp_app(list(requirements.txt = "\\"))
Sys.chmod(file.path(dir, "requirements.txt"), "000")
withr::local_dir(dir)
expect_snapshot(inferPythonEnv(".", pythonPathOrSkip()), error = TRUE)
})
rsconnect/tests/testthat/certs/ 0000755 0001762 0000144 00000000000 14467166424 016410 5 ustar ligges users rsconnect/tests/testthat/certs/localhost.crt 0000644 0001762 0000144 00000000100 14467166424 021101 0 ustar ligges users -----BEGIN CERTIFICATE-----
localhost
-----END CERTIFICATE-----
rsconnect/tests/testthat/certs/two-cas.crt 0000644 0001762 0000144 00000006104 14467166424 020500 0 ustar ligges users Amazon Root CA 1
================
-----BEGIN CERTIFICATE-----
MIIDQTCCAimgAwIBAgITBmyfz5m/jAo54vB4ikPmljZbyjANBgkqhkiG9w0BAQsF
ADA5MQswCQYDVQQGEwJVUzEPMA0GA1UEChMGQW1hem9uMRkwFwYDVQQDExBBbWF6
b24gUm9vdCBDQSAxMB4XDTE1MDUyNjAwMDAwMFoXDTM4MDExNzAwMDAwMFowOTEL
MAkGA1UEBhMCVVMxDzANBgNVBAoTBkFtYXpvbjEZMBcGA1UEAxMQQW1hem9uIFJv
b3QgQ0EgMTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBALJ4gHHKeNXj
ca9HgFB0fW7Y14h29Jlo91ghYPl0hAEvrAIthtOgQ3pOsqTQNroBvo3bSMgHFzZM
9O6II8c+6zf1tRn4SWiw3te5djgdYZ6k/oI2peVKVuRF4fn9tBb6dNqcmzU5L/qw
IFAGbHrQgLKm+a/sRxmPUDgH3KKHOVj4utWp+UhnMJbulHheb4mjUcAwhmahRWa6
VOujw5H5SNz/0egwLX0tdHA114gk957EWW67c4cX8jJGKLhD+rcdqsq08p8kDi1L
93FcXmn/6pUCyziKrlA4b9v7LWIbxcceVOF34GfID5yHI9Y/QCB/IIDEgEw+OyQm
jgSubJrIqg0CAwEAAaNCMEAwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMC
AYYwHQYDVR0OBBYEFIQYzIU07LwMlJQuCFmcx7IQTgoIMA0GCSqGSIb3DQEBCwUA
A4IBAQCY8jdaQZChGsV2USggNiMOruYou6r4lK5IpDB/G/wkjUu0yKGX9rbxenDI
U5PMCCjjmCXPI6T53iHTfIUJrU6adTrCC2qJeHZERxhlbI1Bjjt/msv0tadQ1wUs
N+gDS63pYaACbvXy8MWy7Vu33PqUXHeeE6V/Uq2V8viTO96LXFvKWlJbYK8U90vv
o/ufQJVtMVT8QtPHRh8jrdkPSHCa2XV4cdFyQzR1bldZwgJcJmApzyMZFo6IQ6XU
5MsI+yMRQ+hDKXJioaldXgjUkK642M4UwtBV8ob2xJNDd2ZhwLnoQdeXeGADbkpy
rqXRfboQnoZsG4q5WTP468SQvvG5
-----END CERTIFICATE-----
Amazon Root CA 2
================
-----BEGIN CERTIFICATE-----
MIIFQTCCAymgAwIBAgITBmyf0pY1hp8KD+WGePhbJruKNzANBgkqhkiG9w0BAQwF
ADA5MQswCQYDVQQGEwJVUzEPMA0GA1UEChMGQW1hem9uMRkwFwYDVQQDExBBbWF6
b24gUm9vdCBDQSAyMB4XDTE1MDUyNjAwMDAwMFoXDTQwMDUyNjAwMDAwMFowOTEL
MAkGA1UEBhMCVVMxDzANBgNVBAoTBkFtYXpvbjEZMBcGA1UEAxMQQW1hem9uIFJv
b3QgQ0EgMjCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAK2Wny2cSkxK
gXlRmeyKy2tgURO8TW0G/LAIjd0ZEGrHJgw12MBvIITplLGbhQPDW9tK6Mj4kHbZ
W0/jTOgGNk3Mmqw9DJArktQGGWCsN0R5hYGCrVo34A3MnaZMUnbqQ523BNFQ9lXg
1dKmSYXpN+nKfq5clU1Imj+uIFptiJXZNLhSGkOQsL9sBbm2eLfq0OQ6PBJTYv9K
8nu+NQWpEjTj82R0Yiw9AElaKP4yRLuH3WUnAnE72kr3H9rN9yFVkE8P7K6C4Z9r
2UXTu/Bfh+08LDmG2j/e7HJV63mjrdvdfLC6HM783k81ds8P+HgfajZRRidhW+me
z/CiVX18JYpvL7TFz4QuK/0NURBs+18bvBt+xa47mAExkv8LV/SasrlX6avvDXbR
8O70zoan4G7ptGmh32n2M8ZpLpcTnqWHsFcQgTfJU7O7f/aS0ZzQGPSSbtqDT6Zj
mUyl+17vIWR6IF9sZIUVyzfpYgwLKhbcAS4y2j5L9Z469hdAlO+ekQiG+r5jqFoz
7Mt0Q5X5bGlSNscpb/xVA1wf+5+9R+vnSUeVC06JIglJ4PVhHvG/LopyboBZ/1c6
+XUyo05f7O0oYtlNc/LMgRdg7c3r3NunysV+Ar3yVAhU/bQtCSwXVEqY0VThUWcI
0u1ufm8/0i2BWSlmy5A5lREedCf+3euvAgMBAAGjQjBAMA8GA1UdEwEB/wQFMAMB
Af8wDgYDVR0PAQH/BAQDAgGGMB0GA1UdDgQWBBSwDPBMMPQFWAJI/TPlUq9LhONm
UjANBgkqhkiG9w0BAQwFAAOCAgEAqqiAjw54o+Ci1M3m9Zh6O+oAA7CXDpO8Wqj2
LIxyh6mx/H9z/WNxeKWHWc8w4Q0QshNabYL1auaAn6AFC2jkR2vHat+2/XcycuUY
+gn0oJMsXdKMdYV2ZZAMA3m3MSNjrXiDCYZohMr/+c8mmpJ5581LxedhpxfL86kS
k5Nrp+gvU5LEYFiwzAJRGFuFjWJZY7attN6a+yb3ACfAXVU3dJnJUH/jWS5E4ywl
7uxMMne0nxrpS10gxdr9HIcWxkPo1LsmmkVwXqkLN1PiRnsn/eBG8om3zEK2yygm
btmlyTrIQRNg91CMFa6ybRoVGld45pIq2WWQgj9sAq+uEjonljYE1x2igGOpm/Hl
urR8FLBOybEfdF849lHqm/osohHUqS0nGkWxr7JOcQ3AWEbWaQbLU8uz/mtBzUF+
fUwPfHJ5elnNXkoOrJupmHN5fLT0zLm4BwyydFy4x2+IoZCn9Kr5v2c69BoVYh63
n749sSmvZ6ES8lgQGVMDMBu4Gon2nL2XA46jCfMdiyHxtN/kHNGfZQIG6lzWE7OE
76KlXIx3KadowGuuQNKotOrN8I1LOJwZmhsoVLiJkO/KdYE+HvJkJMcYr07/R54H
9jVlpNMKVv/1F2Rs76giJUmTtt8AF9pYfl3uxRuw0dFfIRDH+fO6AgonB8Xx1sfT
4PsJYGw=
-----END CERTIFICATE-----
rsconnect/tests/testthat/certs/invalid.crt 0000644 0001762 0000144 00000000717 14467166424 020555 0 ustar ligges users Do you remember still the falling stars
that like swift horses through the heavens raced
and suddenly leaped across the hurdles
of our wishes--do you recall? And we
did make so many! For there were countless numbers
of stars: each time we looked above we were
astounded by the swiftness of their daring play,
while in our hearts we felt safe and secure
watching these brilliant bodies disintegrate,
knowing somehow we had survived their fall.
Rainer Maria Rilke
rsconnect/tests/testthat/certs/sample.crt 0000644 0001762 0000144 00000002476 14467166424 020414 0 ustar ligges users -----BEGIN CERTIFICATE-----
MIIDszCCApugAwIBAgIJAJhKUgOoHiBhMA0GCSqGSIb3DQEBCwUAMIGAMQswCQYD
VQQGEwJVUzELMAkGA1UECAwCV0ExEDAOBgNVBAcMB1JlZG1vbmQxEDAOBgNVBAoM
B1JTdHVkaW8xGzAZBgNVBAMMEnJzdHVkaW8tbWVnYS5sb2NhbDEjMCEGCSqGSIb3
DQEJARYUam9uYXRoYW5AcnN0dWRpby5jb20wHhcNMTcwOTAxMjIxNTI5WhcNMjAw
NTI3MjIxNTI5WjBVMQswCQYDVQQGEwJVUzENMAsGA1UECAwETm9uZTELMAkGA1UE
BwwCTkIxDTALBgNVBAoMBE5vbmUxGzAZBgNVBAMMEnJzdHVkaW8tbWVnYS5sb2Nh
bDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBANq8Hgk1vyt7N8mL0qpc
8wVrVavFNo23G887/SDJ/OIQljd3PLY1zJ+KAIZjZ1DNWG3DCfZv3ghser3gi5x/
TTLVI2AMrxYafV9KLOic35ngH6Aj6fgXZC0U0uaqlx5cdd+2SFIgs2l2IZMWXM8o
YLcdes+L5yOfJPlKkASz2Yh9aBCZR6Xf1Bg2M1brwAeMtBB+dXcnXgNAHD0u+dOS
3PMlUugjRPH4b0gmMVnSjLANGGVbJAJiIq2k0ZblgixjiAGpampTTe+ml9KQL38C
HWiJkSTuC6ipZDyjk9BhJTz2fH3wR0yJsk/J3o8hm5u0WBlfttv/VMtsWlhBAc6A
4HkCAwEAAaNaMFgwHwYDVR0jBBgwFoAU21Bn94udZnSVWlZHji9jfc33Cb0wCQYD
VR0TBAIwADALBgNVHQ8EBAMCBPAwHQYDVR0RBBYwFIIScnN0dWRpby1tZWdhLmxv
Y2FsMA0GCSqGSIb3DQEBCwUAA4IBAQCIbnzfsTL80Ls8LmiSuZ6WEG2+9fgWxXYq
VmOq+y0LJboe7Bf86FsbI8KNDJ3SEU0XFDDNio/txRoNomrSX2HKOUwoc9z8jGNV
SWusvlOaaMbH0+Vrid1OMqy8Nk3yyZdhc3cAtN6juG//T/9c8XWA68qFq+W6TIUp
qFpNsfcyN0NjP9pu4ANQzt5vTpVaqkmxHr1d53gAw89hHsBrgMLDpSeQRAnQNt6G
0mcCAwBfEqTK9lDzGiS8vnnD2ovFsQllRyJbzWSttQ7NvTa/nvCs1GfTTOK02K9G
qXn256VmSEjzZgWrKB87Md1/ySOUxi5M8VGoVBRJ7mfuad2/h4S1
-----END CERTIFICATE-----
rsconnect/tests/testthat/certs/store.crt 0000644 0001762 0000144 00000000031 14467166424 020250 0 ustar ligges users == system cert store ==
rsconnect/tests/testthat/shinyapp-singleR/ 0000755 0001762 0000144 00000000000 14536673154 020524 5 ustar ligges users rsconnect/tests/testthat/shinyapp-singleR/single.R 0000644 0001762 0000144 00000000565 14467166424 022136 0 ustar ligges users server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = "darkgray", border = "white")
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("obs", "Number of observations:", min = 10, max = 500,
value = 100)),
mainPanel(plotOutput("distPlot"))))
shinyApp(ui = ui, server = server)
rsconnect/tests/testthat/quarto-doc-none/ 0000755 0001762 0000144 00000000000 14536673151 020300 5 ustar ligges users rsconnect/tests/testthat/quarto-doc-none/quarto-doc-none.qmd 0000644 0001762 0000144 00000000275 14467166424 024025 0 ustar ligges users ---
title: "quarto-doc-none"
---
## Quarto
Quarto enables you to weave together content and executable code into a finished document. To learn more about Quarto see .
rsconnect/tests/testthat/test-cert.R 0000644 0001762 0000144 00000003272 14513230050 017304 0 ustar ligges users test_that("system and server cert stores are concatenated", {
local_temp_config()
# use a dummy CA bundle
withr::local_options(rsconnect.ca.bundle = test_path("certs/store.crt"))
# create and then read the temporary certificate file
concatenated <- createCertificateFile(readLines(test_path("certs/localhost.crt")))
withr::defer(unlink(concatenated))
store <- paste(readLines(concatenated), collapse = "\n")
# make sure that the localhost and system stores both exist in the
# concatenated store
expect_true(grepl("localhost", store, fixed = TRUE))
expect_true(grepl("system", store, fixed = TRUE))
})
test_that("invalid certificates cannot be added", {
local_temp_config()
expect_error(addTestServer(
url = "https://localhost:4567/",
name = "cert_test_e",
certificate = test_path("certs/invalid.crt")
))
})
test_that("certificates not used when making plain http connections", {
local_temp_config()
local_http_recorder()
GET(
list(
protocol = "http",
host = "localhost:4567",
port = "80",
path = "apps"
),
authInfo = list(certificate = test_path("certs/localhost.crt")),
"apps"
)
expect_equal(httpLastRequest$certificate, NULL)
})
test_that("certificates used when making https connections", {
local_temp_config()
local_http_recorder()
GET(
list(
protocol = "https",
host = "localhost:4567",
port = "443",
path = "apps"
),
authInfo = list(certificate = test_path("certs/localhost.crt")),
"apps"
)
# we expect to get a cert file
expect_true(file.exists(httpLastRequest$certificate))
# clean up
unlink(httpLastRequest$certificate)
})
rsconnect/tests/testthat/quarto-website-r/ 0000755 0001762 0000144 00000000000 14536742742 020502 5 ustar ligges users rsconnect/tests/testthat/quarto-website-r/_quarto.yml 0000644 0001762 0000144 00000000357 14467166424 022704 0 ustar ligges users project:
type: website
website:
title: "quarto-website-r"
navbar:
background: primary
left:
- href: index.qmd
text: Home
- about.qmd
format:
html:
theme: cosmo
css: styles.css
editor: visual
rsconnect/tests/testthat/quarto-website-r/styles.css 0000644 0001762 0000144 00000000021 14467166424 022530 0 ustar ligges users /* css styles */
rsconnect/tests/testthat/quarto-website-r/README.md 0000644 0001762 0000144 00000001772 14467166424 021770 0 ustar ligges users # quarto-website-r
A minimal Quarto website with an R/knitr runtime
## Creation and Contents
- This project was created by making a new Quarto website in the IDE and selecting selecting knitr as the runtime.
- The `manifest.json` was extracted from the source bundle after using push-button deployment in the IDE. It was edited to remove IDE files that don't exist in the bundle.
## `quarto inspect`
```json
{
"quarto": {
"version": "0.9.16"
},
"engines": [
"knitr"
],
"config": {
"project": {
"type": "website",
"lib-dir": "site_libs",
"output-dir": "_site"
},
"website": {
"title": "quarto-website-r",
"navbar": {
"background": "primary",
"left": [
{
"href": "index.qmd",
"text": "Home"
},
"about.qmd"
]
}
},
"format": {
"html": {
"theme": "cosmo",
"css": "styles.css"
}
},
"editor": "visual",
"language": {}
}
}
```
rsconnect/tests/testthat/quarto-website-r/index.qmd 0000644 0001762 0000144 00000000236 14467166424 022315 0 ustar ligges users ---
title: "quarto-website-r"
---
This is a Quarto website.
To learn more about Quarto websites visit .
```{r}
1 + 1
```
rsconnect/tests/testthat/quarto-website-r/about.qmd 0000644 0001762 0000144 00000000072 14467166424 022316 0 ustar ligges users ---
title: "About"
---
About this site
```{r}
1 + 1
```
rsconnect/tests/testthat/test-title.R 0000644 0001762 0000144 00000001575 14513230050 017474 0 ustar ligges users test_that("generated application names do not exceed maximum length", {
title <- "Good heavens, this title is simply enormous! I can't imagine why anyone would use such a cumbersome moniker."
name <- generateAppName(title)
expect_lt(nchar(name), 65)
})
test_that("empty titles are rejected", {
title <- ""
expect_error(generateAppName(title))
})
test_that("path is used to generate valid title if title isn't specified", {
title <- NULL
path <- "shiny-app-in-subdir"
name <- generateAppName(title, path)
expect_gt(nchar(name), 5)
})
test_that("invalid characters are removed from titles", {
title <- "Free!* (* = With $5 Donation)"
name <- generateAppName(title)
expect_false(grepl("[!*=$]", name))
})
test_that("valid characters are not removed from titles", {
title <- "inexpensive_kittens-5"
name <- generateAppName(title)
expect_identical(title, name)
})
rsconnect/tests/testthat/test-applications.R 0000644 0001762 0000144 00000001754 14513230050 021040 0 ustar ligges users test_that("syncAppMetadata updates deployment records", {
local_temp_config()
addTestServer()
addTestAccount("ron")
app <- local_temp_app()
addTestDeployment(app, appId = "123", metadata = list(when = 123))
local_mocked_bindings(clientForAccount = function(...) {
list(
getApplication = function(...) list(title = "newtitle", url = "newurl")
)
})
syncAppMetadata(app)
deps <- deployments(app)
expect_equal(deps$title, "newtitle")
expect_equal(deps$url, "newurl")
expect_equal(deps$when, NULL)
})
test_that("syncAppMetadata deletes deployment records if needed", {
local_temp_config()
addTestServer()
addTestAccount("ron")
app <- local_temp_app()
addTestDeployment(app, appId = "123", metadata = list(when = 123))
local_mocked_bindings(clientForAccount = function(...) {
list(
getApplication = function(...) abort(class = "rsconnect_http_404")
)
})
expect_snapshot(syncAppMetadata(app))
expect_equal(nrow(deployments(app)), 0)
})
rsconnect/tests/testthat/test-cookies.R 0000644 0001762 0000144 00000023041 14513230050 017777 0 ustar ligges users test_that("Parsing cookies works", {
# Note that the Expires field is ignored
cookie <- parseCookie("mycookie=myvalue; Path=/; Expires=Sat, 24 Jun 2017 16:16:05 GMT; Max-Age=3600; HttpOnly", "/")
expect_equal(cookie$name, "mycookie")
expect_equal(cookie$value, "myvalue")
expect_true(cookie$expires > Sys.time() + 3595)
expect_true(cookie$expires < Sys.time() + 3605)
expect_equal(cookie$path, "/")
expect_false(cookie$secure)
# Max-Age with no semicolon, non-root path
cookie <- parseCookie("mycookie2=myvalue2; Secure; Path=/test; max-AGE=3600")
expect_equal(cookie$name, "mycookie2")
expect_equal(cookie$value, "myvalue2")
expect_true(cookie$expires > Sys.time() + 3595)
expect_true(cookie$expires < Sys.time() + 3605)
expect_equal(cookie$path, "/test")
expect_true(cookie$secure)
# Path with no semicolon, no max age
cookie <- parseCookie("mycookie2=myvalue2; PATH=/test")
expect_equal(cookie$name, "mycookie2")
expect_equal(cookie$value, "myvalue2")
expect_true(cookie$expires > (Sys.time() + 10^9))
expect_equal(cookie$path, "/test")
expect_false(cookie$secure)
# No path, value with no semicolon
cookie <- parseCookie("mycookie2=myvalue2")
expect_equal(cookie$name, "mycookie2")
expect_equal(cookie$value, "myvalue2")
expect_true(cookie$expires > (Sys.time() + 10^9))
expect_equal(cookie$path, "/")
expect_false(cookie$secure)
# Trailing secure
cookie <- parseCookie("mycookie2=myvalue2; Secure")
expect_equal(cookie$name, "mycookie2")
expect_equal(cookie$value, "myvalue2")
expect_true(cookie$expires > (Sys.time() + 10^9))
expect_equal(cookie$path, "/")
expect_true(cookie$secure)
# Full cookie with spaces around =s
cookie <- parseCookie("mycookie = myvalue; SEcure; Path = /; Expires = Sat, 24 Jun 2017 16:16:05 GMT; Max-Age = 3600; HttpOnly")
expect_equal(cookie$name, "mycookie")
expect_equal(cookie$value, "myvalue")
expect_true(cookie$secure)
expect_true(cookie$expires > Sys.time() + 3595)
expect_true(cookie$expires < Sys.time() + 3605)
expect_equal(cookie$path, "/")
# Value-less cookie
cookie <- parseCookie("mycookie=; Path = /")
expect_equal(cookie$name, "mycookie")
expect_equal(cookie$value, "")
expect_equal(cookie$path, "/")
# prove #229 is fixed
cookie <- parseCookie("my_cookie-which/uses%20strange?characters=foo_-%20+?1234bar; Path = /")
expect_equal(cookie$name, "my_cookie-which/uses%20strange?characters")
expect_equal(cookie$value, "foo_-%20+?1234bar")
expect_equal(cookie$path, "/")
})
test_that("Invalid cookies fail parsing", {
# Invalid path, doesn't match request's path
expect_snapshot(cookie <- parseCookie("x=1; Path=/something/else", "/path"))
expect_null(cookie)
# Invalid key/val format
expect_snapshot(cookie <- parseCookie("mycookie;"))
expect_null(cookie)
})
test_that("cookies can be stored", {
local_cookie_store()
parsedUrl <- parseHttpUrl("http://fakedomain:123/test/stuff")
expect_warning({
storeCookies(parsedUrl, c(
"mycookie=myvalue; Path=/; Max-Age=3600; HttpOnly",
"anotherCookie=what; Path=/test; Max-Age=100",
"wrongpath=huh; Path=/uhoh; Max-Age=100",
"secureCookie=123; Secure",
"third=cookie; Path=/; Max-Age=500")
)
}, "Invalid path set for cookie")
cookies <- get("fakedomain:123", envir = .cookieStore)
expect_equal(nrow(cookies), 4)
# Check the first cookie
co <- cookies[cookies$name == "mycookie", ]
expect_equal(co$name, "mycookie")
expect_equal(co$value, "myvalue")
expect_true(co$expires > Sys.time() + 3595)
expect_true(co$expires < Sys.time() + 3605)
expect_equal(co$path, "/")
expect_false(co$secure)
# And the other
co <- cookies[cookies$name == "anotherCookie", ]
expect_equal(co$name, "anotherCookie")
expect_equal(co$value, "what")
expect_true(co$expires > Sys.time() + 95)
expect_true(co$expires < Sys.time() + 105)
expect_equal(co$path, "/test")
expect_false(co$secure)
# Third
co <- cookies[cookies$name == "third", ]
expect_equal(co$name, "third")
expect_equal(co$value, "cookie")
expect_true(co$expires > Sys.time() + 495)
expect_true(co$expires < Sys.time() + 505)
expect_equal(co$path, "/")
expect_false(co$secure)
# Fourth
co <- cookies[cookies$name == "secureCookie", ]
expect_equal(co$name, "secureCookie")
expect_equal(co$value, "123")
expect_true(co$secure)
})
test_that("duplicate cookies overwrite one another", {
local_cookie_store()
parsedUrl <- parseHttpUrl("http://fakedomain:123/test/stuff")
storeCookies(parsedUrl, "mycookie=myvalue; Path=/; Max-Age=3600")
cookies <- get("fakedomain:123", envir = .cookieStore)
expect_equal(nrow(cookies), 1)
# Add another valid cookie, same domain, same name, different path
storeCookies(parsedUrl, "mycookie=myvalue; Path=/test; Max-Age=3600")
cookies <- get("fakedomain:123", envir = .cookieStore)
expect_equal(nrow(cookies), 2)
# Duplicate cookie should overwrite
storeCookies(parsedUrl, "mycookie=myvalue; Path=/test; Max-Age=99")
cookies <- get("fakedomain:123", envir = .cookieStore)
expect_equal(nrow(cookies), 2)
# Confirm that the stored cookie is the more recent one.
co <- cookies[cookies$path == "/test", ]
expect_true(co$expires > Sys.time() + 94)
expect_true(co$expires < Sys.time() + 104)
})
test_that("appending cookie headers works", {
local_cookie_store()
parsedUrl <- parseHttpUrl("http://fakedomain:123/test/stuff")
# Nothing to append, no-op
headers <- appendCookieHeaders(parsedUrl, c(header1 = 123, header2 = "abc"))
expect_length(headers, 2)
expect_equal(headers[["header1"]], "123")
expect_equal(headers[["header2"]], "abc")
# Store a cookie
storeCookies(parsedUrl, "cookie1=value1; Path=/; Max-Age=3600")
headers <- appendCookieHeaders(parsedUrl, c(header1 = 123, header2 = "abc"))
expect_length(headers, 3)
expect_equal(headers[["header1"]], "123")
expect_equal(headers[["header2"]], "abc")
expect_equal(headers[["cookie"]], "cookie1=value1")
# Store a couple more cookies
storeCookies(parsedUrl, "cookie2=value2; Path=/test; Max-Age=3600")
# This one has the wrong path, will be filtered out
storeCookies(parseHttpUrl("http://fakedomain:123/another"), "cookie3=value3; Path=/another; Max-Age=3600")
headers <- appendCookieHeaders(parsedUrl, c(header1 = 123, header2 = "abc"))
expect_length(headers, 3)
expect_equal(headers[["header1"]], "123")
expect_equal(headers[["header2"]], "abc")
expect_equal(headers[["cookie"]], "cookie2=value2; cookie1=value1")
# If you already have a cookie header, you end up with two
headers <- appendCookieHeaders(parsedUrl, c(cookie = "existing=value"))
expect_length(headers, 2)
expect_equal(headers[1], c(cookie = "existing=value"))
expect_equal(headers[2], c(cookie = "cookie2=value2; cookie1=value1"))
# Add a secure cookie
storeCookies(parsedUrl, "securecookie=secureval; Path=/; Max-Age=3600; Secure")
headers <- appendCookieHeaders(parsedUrl, c())
expect_equal(headers[["cookie"]], "cookie2=value2; cookie1=value1")
# But over a secure channel, you'd include the secure cookie
headers <- appendCookieHeaders(parseHttpUrl("https://fakedomain:123/test/stuff"), c())
expect_equal(headers[["cookie"]], "securecookie=secureval; cookie2=value2; cookie1=value1")
})
test_that("Expired cookies are removed", {
local_cookie_store()
parsedUrl <- parseHttpUrl("http://fakedomain:123/test/stuff")
# Expired cookies are removed from the store and not included in the request
storeCookies(parsedUrl, "expired=something; Max-Age=-1")
cookies <- get("fakedomain:123", envir = .cookieStore)
expect_equal(nrow(cookies), 1)
# Now it will recognize that it's expired and remove it
headers <- appendCookieHeaders(parsedUrl, NULL)
expect_null(headers)
cookies <- get("fakedomain:123", envir = .cookieStore)
expect_equal(nrow(cookies), 0)
# And with multiple cookies, it still removes only the expired one
storeCookies(parsedUrl, "expired=something; Max-Age=-1")
storeCookies(parsedUrl, "notexpired=something")
cookies <- get("fakedomain:123", envir = .cookieStore)
expect_equal(nrow(cookies), 2)
# Now it will recognize that it's expired and remove it
headers <- appendCookieHeaders(parsedUrl, c())
expect_length(headers, 1)
cookies <- get("fakedomain:123", envir = .cookieStore)
expect_equal(nrow(cookies), 1)
})
test_that("getCookieHost works", {
expect_equal(getCookieHost(parseHttpUrl("http://rstudio.com")), "rstudio.com")
expect_equal(getCookieHost(parseHttpUrl("http://rstudio.com:3939")), "rstudio.com:3939")
expect_equal(getCookieHost(parseHttpUrl("http://127.0.0.1")), "127.0.0.1")
expect_equal(getCookieHost(parseHttpUrl("http://127.0.0.1:3939")), "127.0.0.1:3939")
})
test_that("getting and clearing cookies works", {
local_cookie_store()
all <- getCookies()
expect_null(all)
# Add a few cookies
domain1 <- parseHttpUrl("http://domain1/test/stuff")
storeCookies(domain1, "c1=v1")
storeCookies(domain1, "c2=v2")
domain2 <- parseHttpUrl("http://domain2:3939/test/stuff")
storeCookies(domain2, "c3=v3")
d1c <- getCookies("domain1")
expect_equal(nrow(d1c), 2)
expect_equal(d1c$host[1], "domain1")
d2c <- getCookies("domain2")
expect_null(d2c)
d2c <- getCookies("domain2", 3939)
expect_equal(nrow(d2c), 1)
expect_equal(d2c$host[1], "domain2:3939")
all <- getCookies()
expect_equal(nrow(all), 3)
# Delete cookies from one domain
clearCookies("domain2", 3939)
d2c <- getCookies("domain2", 3939)
expect_null(d2c)
all <- getCookies()
expect_equal(nrow(all), 2)
# Clear all cookies
clearCookies()
d1c <- getCookies("domain1")
expect_null(d1c)
all <- getCookies()
expect_null(all)
})
rsconnect/tests/testthat/shiny-rmds/ 0000755 0001762 0000144 00000000000 14536673154 017365 5 ustar ligges users rsconnect/tests/testthat/shiny-rmds/non-shiny-rmd.Rmd 0000644 0001762 0000144 00000000110 14467166424 022523 0 ustar ligges users ---
title: Not a Shiny R Markdown Document
output: html_document
---
rsconnect/tests/testthat/shiny-rmds/shiny-rmd-dots.Rmd 0000644 0001762 0000144 00000000140 14467166424 022705 0 ustar ligges users ---
title: Shiny R Markdown with Dots
output: html_document
runtime: shiny
...
Hello, world!
rsconnect/tests/testthat/shiny-rmds/shiny-rmd-dashes.Rmd 0000644 0001762 0000144 00000000123 14467166424 023204 0 ustar ligges users ---
title: Shiny R Markdown with Dashes
output: html_document
runtime: shiny
---
rsconnect/tests/testthat/test-servers-deprec.R 0000644 0001762 0000144 00000000264 14513230050 021276 0 ustar ligges users test_that("addConnectServer is deprecated", {
skip_on_cran()
local_temp_config()
expect_snapshot(
addConnectServer("https://colorado.posit.co/rsc", quiet = TRUE)
)
})
rsconnect/tests/testthat/test-accounts.R 0000644 0001762 0000144 00000004662 14536333553 020213 0 ustar ligges users test_that("no accounts returns empty data frame", {
local_temp_config()
expect_equal(
accounts(),
data.frame(name = character(), server = character(), stringsAsFactors = FALSE)
)
})
test_that("hasAccounts works", {
local_temp_config()
addTestServer()
addTestAccount("john")
expect_true(hasAccount("john", "example.com"))
expect_false(hasAccount("john", "example2.com"))
expect_false(hasAccount("mary", "example.com"))
})
test_that("secrets are hidden from casual inspection", {
local_temp_config()
registerAccount("server", "1", "id", token = "token", secret = "SECRET")
registerAccount("server", "2", "id", token = "token", private_key = "SECRET")
registerAccount("server", "3", "id", apiKey = "SECRET")
expect_snapshot({
accountInfo("1")$secret
accountInfo("2")$private_key
accountInfo("3")$apiKey
})
})
test_that("setAccountInfo() gives nice error on bad copy and paste", {
expect_snapshot(setAccountInfo("name", "token", ""), error = TRUE)
})
test_that("accountInfo() returns account information", {
local_temp_config()
addTestServer()
addTestAccount("john")
accountDetails <- accountInfo("john", "example.com")
expect_equal(accountDetails$name, "john")
expect_equal(accountDetails$username, "john")
expect_equal(accountDetails$server, "example.com")
})
test_that("accountInfo() returns account information", {
local_temp_config()
addTestServer()
addTestAccount("john")
accountDetails <- accountInfo("john", "example.com")
expect_equal(accountDetails$name, "john")
# username is included for backwards compatibility. (#1024)
expect_equal(accountDetails$username, "john")
expect_equal(accountDetails$server, "example.com")
})
test_that("accountInfo() returns pre-rsconnect-1.0.0 account information", {
local_temp_config()
addTestServer()
# Subset of rsconnect-0.8.29 account fields.
fields <- list(
username = "john",
server = "example.com",
accountId = "john"
)
path <- accountConfigFile("john", "example.com")
dir.create(dirname(path), recursive = TRUE, showWarnings = FALSE)
write.dcf(compact(fields), path, width = 100)
accountDetails <- accountInfo("john", "example.com")
# name copied from username, as "name" is the current field name.
expect_equal(accountDetails$name, "john")
# username retained for backwards compatibility.
expect_equal(accountDetails$username, "john")
expect_equal(accountDetails$server, "example.com")
})
rsconnect/tests/testthat/project-MASS/ 0000755 0001762 0000144 00000000000 14467166424 017477 5 ustar ligges users rsconnect/tests/testthat/project-MASS/MASS.R 0000644 0001762 0000144 00000000016 14467166424 020362 0 ustar ligges users library(MASS)
rsconnect/tests/testthat/test-bundleFiles.R 0000644 0001762 0000144 00000021000 14513230050 020570 0 ustar ligges users
# listDeploymentFiles ------------------------------------------------------
test_that("can read all files from directory", {
dir <- local_temp_app(list("a.R" = "", "b.R" = ""))
expect_equal(listDeploymentFiles(dir), c("a.R", "b.R"))
expect_equal(listDeploymentFiles(dir, NULL, NULL), c("a.R", "b.R"))
dir <- local_temp_app()
expect_snapshot(listDeploymentFiles(dir), error = TRUE)
})
test_that("can read selected files from directory", {
dir <- local_temp_app(list("a.R" = "", "b.R" = ""))
expect_equal(listDeploymentFiles(dir, "b.R"), "b.R")
expect_snapshot(out <- listDeploymentFiles(dir, c("b.R", "c.R")))
expect_equal(out, "b.R")
expect_snapshot(listDeploymentFiles(dir, character()), error = TRUE)
})
test_that("can read selected files from manifest", {
dir <- local_temp_app(list(
"a.R" = "",
"b.R" = "",
"manifest" = "b.R"
))
expect_equal(
listDeploymentFiles(dir, appFileManifest = file.path(dir, "manifest")),
"b.R"
)
dir <- local_temp_app(list(
"a.R" = "",
"b.R" = "",
"manifest" = c("b.R", "c.R")
))
expect_snapshot(
out <- listDeploymentFiles(dir, appFileManifest = file.path(dir, "manifest")),
)
expect_equal(out, "b.R")
# errors if no matching files
dir <- local_temp_app(list(
"manifest" = ""
))
expect_snapshot(
listDeploymentFiles(dir, appFileManifest = file.path(dir, "manifest")),
error = TRUE
)
})
test_that("checks its inputs", {
dir <- local_temp_app()
expect_snapshot(error = TRUE, {
listDeploymentFiles(dir)
listDeploymentFiles(dir, appFiles = "a.R", appFileManifest = "b.R")
listDeploymentFiles(dir, appFiles = 1)
listDeploymentFiles(dir, appFileManifest = "doestexist")
})
})
# listBundleFiles ---------------------------------------------------------
test_that("bundle directories are recursively enumerated", {
dir <- withr::local_tempdir()
# tree that resembles the case from https://github.com/rstudio/rsconnect/issues/464
files <- c(
"app.R",
"index.htm",
"models/abcd/a_b_pt1/a/b/c1/1.RDS",
"models/abcd/a_b_pt1/a/b/c1/2.RDS",
"models/abcd/a_b_pt1/a/b/c1/3.RDS",
"models/abcd/a_b_pt1/a/b/c1/4.RDS",
"models/abcd/a_b_pt1/a/b/c1/5.RDS"
)
dirCreate(file.path(dir, "models/abcd/a_b_pt1/a/b/c1/"))
file.create(file.path(dir, files))
size <- sum(file.info(file.path(dir, files))$size)
result <- listBundleFiles(dir)
# Files are included in the list, count, and sizes, not directories.
# Paths are enumerated relative to the target directory, not absolute paths.
expect_identical(result$contents, files)
expect_equal(result$totalSize, size)
expect_equal(result$totalFiles, length(files))
})
test_that("ignores RStudio files", {
dir <- withr::local_tempdir()
file.create(file.path(dir, c("test.Rproj", ".Rproj.user", "rsconnect")))
expect_equal(bundleFiles(dir), character())
})
test_that("ignores knitr cache directories", {
dir <- withr::local_tempdir()
dirCreate(file.path(dir, c("foo_cache", "bar_cache")))
file.create(file.path(dir, c("foo_cache", "bar_cache"), "contents"))
file.create(file.path(dir, c("foo.Rmd")))
expect_setequal(bundleFiles(dir), c("bar_cache/contents", "foo.Rmd"))
})
test_that("ignores files anywhere in path", {
dir <- withr::local_tempdir()
dirCreate(file.path(dir, "a/b/c"))
file.create(file.path(dir, c("x", "a/b/.gitignore", "a/b/c/.DS_Store")))
expect_equal(bundleFiles(dir), "x")
})
test_that("ignores files listed in .rscignore", {
dir <- local_temp_app()
dirCreate(file.path(dir, "a"))
file.create(file.path(dir, c("x", "a/y")))
expect_setequal(bundleFiles(dir), c("x", "a/y"))
writeLines("x", file.path(dir, ".rscignore"))
expect_setequal(bundleFiles(dir), "a/y")
writeLines("y", file.path(dir, "a/.rscignore"))
expect_setequal(bundleFiles(dir), character())
})
test_that("ignores temporary files", {
ignored <- ignoreBundleFiles(
dir = ".",
contents = c("foo.xlsx", "~$foo.xlsx", "foo.csv", "foo.csv~")
)
expect_equal(ignored, c("foo.xlsx", "foo.csv"))
})
test_that("ignores Python virtual envs (non-Windows)", {
dir <- withr::local_tempdir()
names <- c(
# well-known names ...
".env", ".venv", "venv",
# other names ...
"test"
)
dirCreate(file.path(dir, names, "bin"))
file.create(file.path(dir, names, "bin", "python"))
expect_equal(bundleFiles(dir), character())
})
test_that("ignores Python virtual envs (Windows)", {
dir <- withr::local_tempdir()
names <- c(
# well-known names ...
".env", ".venv", "venv",
# other names ...
"test"
)
dirCreate(file.path(dir, names, "Scripts"))
file.create(file.path(dir, names, "Scripts", "python.exe"))
expect_equal(bundleFiles(dir), character())
})
test_that("ignores Python virtual envs (Windows-GUI)", {
dir <- withr::local_tempdir()
names <- c(
# well-known names ...
".env", ".venv", "venv",
# other names ...
"test"
)
dirCreate(file.path(dir, names, "Scripts"))
file.create(file.path(dir, names, "Scripts", "pythonw.exe"))
expect_equal(bundleFiles(dir), character())
})
test_that("ignores Python virtual envs (Windows-debug)", {
dir <- withr::local_tempdir()
names <- c(
# well-known names ...
".env", ".venv", "venv",
# other names ...
"test"
)
dirCreate(file.path(dir, names, "Scripts"))
file.create(file.path(dir, names, "Scripts", "pythond.exe"))
expect_equal(bundleFiles(dir), character())
})
test_that("preserves well-known names when not Python virtual environment", {
dir <- withr::local_tempdir()
file.create(file.path(dir, c(".env", ".venv", "venv")))
expect_setequal(bundleFiles(dir), c(".env", ".venv", "venv"))
})
# explodeFiles ------------------------------------------------------------
test_that("returns relative paths", {
dir <- withr::local_tempdir()
dirCreate(file.path(dir, "x"))
file.create(file.path(dir, "x", c("a", "b", "c")))
expect_equal(explodeFiles(dir, "x"), c("x/a", "x/b", "x/c"))
})
test_that("drops drops non-existent files with warning", {
dir <- withr::local_tempdir()
file.create(file.path(dir, c("a", "b", "c")))
expect_snapshot(out <- explodeFiles(dir, c("a", "d")))
expect_equal(out, "a")
})
test_that("expands files and directory", {
dir <- withr::local_tempdir()
dirCreate(file.path(dir, "x"))
file.create(file.path(dir, "x", c("a", "b")))
file.create(file.path(dir, "c"))
expect_equal(explodeFiles(dir, c("x", "c")), c("x/a", "x/b", "c"))
})
test_that("can include nested files/directories", {
dir <- withr::local_tempdir()
dirCreate(file.path(dir, "x", "y"))
file.create(file.path(dir, "x", c("a", "b", "c")))
file.create(file.path(dir, "x", "y", c("d", "e")))
expect_equal(explodeFiles(dir, "x/a"), "x/a")
expect_equal(explodeFiles(dir, "x/y"), c("x/y/d", "x/y/e"))
expect_equal(explodeFiles(dir, c("x/a", "x/y/d")), c("x/a", "x/y/d"))
})
test_that("doesn't ignore user supplied files", {
dir <- withr::local_tempdir()
dirCreate(file.path(dir, "x", "y"))
file.create(file.path(dir, "x", "packrat"))
file.create(file.path(dir, "x", "y", "packrat"))
expect_equal(explodeFiles(dir, "x"), c("x/packrat", "x/y/packrat"))
})
# enforceBundleLimits -----------------------------------------------------
test_that("explodeFiles() and bundleFiles() both eagerly enforce limits", {
dir <- withr::local_tempdir()
dirCreate(file.path(dir, c("a", "b")))
file.create(file.path(dir, "a", letters))
file.create(file.path(dir, "b", letters))
withr::local_options(rsconnect.max.bundle.files = 1)
# there are 52 files total, so eagerly implies we stop after one directory
expect_error(explodeFiles(dir, c("a", "b")), "at least 2")
expect_error(bundleFiles(dir), "at least 2")
})
test_that("generate nicely formatted messages", {
dir <- withr::local_tempdir()
file.create(file.path(dir, c("a", "b")))
writeLines(letters, file.path(dir, "c"))
withr::local_options(
rsconnect.max.bundle.files = 1,
rsconnect.max.bundle.size = 5
)
expect_snapshot(
{
explodeFiles(dir, c("a", "b"))
explodeFiles(dir, "c")
},
error = TRUE,
transform = function(x) {
x <- gsub(dir, "", x, fixed = TRUE)
# file size is different on windows because of \r\n
x <- gsub("\\d{2,} bytes", "?? bytes", x)
x
}
)
})
# detectLongNames ---------------------------------------------------------
test_that("detectLongNames produces informative warning if needed", {
skip_on_os("windows")
dir <- local_temp_app(c("a.r" = "", "b.r" = "", "c.r" = ""))
expect_snapshot(detectLongNames(dir, 0))
expect_silent(detectLongNames(dir, Inf))
})
rsconnect/tests/testthat/test-deployments-find.R 0000644 0001762 0000144 00000002344 14513230050 021627 0 ustar ligges users test_that("error when no deployments and no accounts", {
local_temp_config()
app <- local_temp_app()
expect_snapshot(findDeployment(app, appName = "placeholder"), error = TRUE)
})
test_that("returns stubbed details when single account has no deployments", {
local_temp_config()
addTestServer()
addTestAccount()
app <- local_temp_app()
# derived from directory name.
dep <- findDeployment(app)
expect_equal(dep, list(name = basename(app), account = "ron", server = "example.com"))
# name given.
dep <- findDeployment(app, appName = "placeholder")
expect_equal(dep, list(name = "placeholder", account = "ron", server = "example.com"))
})
test_that("finds single deployment", {
local_temp_config()
addTestServer()
addTestAccount()
app <- local_temp_app()
addTestDeployment(app)
dep <- findDeployment(app)
expect_equal(dep$name, "test")
})
test_that("disambiguates multiple deployments", {
local_temp_config()
addTestServer()
addTestAccount()
app <- local_temp_app()
addTestDeployment(app, "test1")
addTestDeployment(app, "test2")
expect_snapshot(findDeployment(app), error = TRUE)
simulate_user_input(2)
expect_snapshot(dep <- findDeployment(app))
expect_equal(dep$name, "test2")
})
rsconnect/tests/testthat/test-bundlePackage.R 0000644 0001762 0000144 00000011242 14513230050 021070 0 ustar ligges users test_that("can snapshot deps with renv", {
app_dir <- local_temp_app(list(foo.R = "library(foreign); library(MASS)"))
expect_snapshot(pkgs <- bundlePackages(app_dir))
# renv is not a dependency
expect_named(pkgs, c("foreign", "MASS"), ignore.order = TRUE)
expect_named(pkgs$foreign, c("Source", "Repository", "description"))
expect_named(pkgs$MASS, c("Source", "Repository", "description"))
# No renv lockfile left behind
expect_equal(list.files(app_dir), "foo.R")
})
test_that("can snapshot deps with packrat (option)", {
withr::local_options(rsconnect.packrat = TRUE)
app_dir <- local_temp_app(list(foo.R = "library(foreign); library(MASS)"))
expect_snapshot(pkgs <- bundlePackages(app_dir))
expect_named(pkgs, c("foreign", "MASS"), ignore.order = TRUE)
expect_named(pkgs$foreign, c("Source", "Repository", "description"))
expect_named(pkgs$MASS, c("Source", "Repository", "description"))
# No packrat lockfile left behind
expect_equal(list.files(app_dir), "foo.R")
})
test_that("can snapshot deps with packrat (env var)", {
withr::local_envvar(RSCONNECT_PACKRAT = "TRUE")
app_dir <- local_temp_app(list(foo.R = "library(foreign); library(MASS)"))
expect_snapshot(pkgs <- bundlePackages(app_dir))
expect_named(pkgs, c("foreign", "MASS"), ignore.order = TRUE)
expect_named(pkgs$foreign, c("Source", "Repository", "description"))
expect_named(pkgs$MASS, c("Source", "Repository", "description"))
# No packrat lockfile left behind
expect_equal(list.files(app_dir), "foo.R")
})
test_that("can capture deps from renv lockfile", {
withr::local_options(renv.verbose = FALSE)
app_dir <- local_temp_app(list(foo.R = "library(foreign); library(MASS)"))
renv::snapshot(app_dir, prompt = FALSE)
expect_snapshot(pkgs <- bundlePackages(app_dir))
# renv is included by the renv.lock
expect_named(pkgs, c("foreign", "MASS", "renv"), ignore.order = TRUE)
expect_named(pkgs$foreign, c("Source", "Repository", "description"))
expect_named(pkgs$MASS, c("Source", "Repository", "description"))
# No renv directory left behind, but the renv.lock is preserved.
expect_equal(list.files(app_dir), c("foo.R", "renv.lock"))
})
test_that("can capture deps with packrat even when renv lockfile present", {
withr::local_envvar(RSCONNECT_PACKRAT = "TRUE")
withr::local_options(renv.verbose = FALSE)
app_dir <- local_temp_app(list(foo.R = "library(foreign); library(MASS)"))
renv::snapshot(app_dir, prompt = FALSE)
expect_snapshot(pkgs <- bundlePackages(app_dir))
# renv is not a dependency (not using renv.lock)
expect_named(pkgs, c("foreign", "MASS"), ignore.order = TRUE)
expect_named(pkgs$foreign, c("Source", "Repository", "description"))
expect_named(pkgs$MASS, c("Source", "Repository", "description"))
# The (incoming) renv.lock is discarded, mirroring rsconnect pre 1.0.0.
expect_equal(list.files(app_dir), "foo.R")
})
# -------------------------------------------------------------------------
test_that("error if can't find source", {
local_mocked_bindings(snapshotRenvDependencies = function(...) {
data.frame(
Package = "shiny",
Source = NA,
Repository = NA,
stringsAsFactors = FALSE
)
})
app_dir <- withr::local_tempdir()
writeLines(con = file.path(app_dir, "index.Rmd"), c(
"```{r}",
"library(shiny)",
"```"
))
expect_snapshot(
. <- bundlePackages(app_dir),
error = TRUE
)
})
test_that("usePackrat respects the environment variable", {
expect_false(usePackrat())
withr::local_envvar(RSCONNECT_PACKRAT = "TRUE")
expect_true(usePackrat())
withr::local_envvar(RSCONNECT_PACKRAT = "FALSE")
expect_false(usePackrat())
})
test_that("usePackrat respects the option", {
expect_false(usePackrat())
withr::local_options(rsconnect.packrat = TRUE)
expect_true(usePackrat())
withr::local_options(rsconnect.packrat = FALSE)
expect_false(usePackrat())
})
test_that("usePackrat prefers the environment variable over the option", {
expect_false(usePackrat())
withr::local_envvar(RSCONNECT_PACKRAT = "TRUE")
withr::local_options(rsconnect.packrat = FALSE)
expect_true(usePackrat())
withr::local_envvar(RSCONNECT_PACKRAT = "FALSE")
withr::local_options(rsconnect.packrat = TRUE)
expect_false(usePackrat())
})
test_that("package_record works", {
latin1Record <- package_record("latin1package", lib_dir = test_path("packages"))
expect_equal(latin1Record$Author, "Jens Fröhling")
utf8Record <- package_record("utf8package", lib_dir = test_path("packages"))
expect_equal(utf8Record$Author, "Jens Fröhling")
windows1251Record <- package_record("windows1251package", lib_dir = test_path("packages"))
expect_equal(windows1251Record$Author, "Сергей Брин")
})
rsconnect/tests/testthat/test-locale.R 0000644 0001762 0000144 00000001102 14513230050 017574 0 ustar ligges users test_that("locale is en_US on mac GHA", {
skip_on_os(c("linux", "windows"))
skip_if_not(identical(Sys.getenv("GITHUB_ACTIONS"), "true"))
expect_equal(detectLocale(), "en_US")
})
test_that("locale is en_US on mac GHA", {
skip_on_os(c("linux", "mac"))
skip_if_not(identical(Sys.getenv("GITHUB_ACTIONS"), "true"))
expect_equal(windowsLocale(), "en_US")
})
test_that("normalizeLocale handles common forms", {
expect_equal(normalizeLocale("en-US"), "en_US")
expect_equal(normalizeLocale("az-Cyrl"), "az")
expect_equal(normalizeLocale("az-Cyrl-AZ"), "az_AZ")
})
rsconnect/tests/testthat/test-deployDoc.R 0000644 0001762 0000144 00000006005 14513230050 020266 0 ustar ligges users test_that("deployDoc correctly reports bad path", {
skip_on_cran()
expect_snapshot(deployDoc("doesntexist.Rmd"), error = TRUE)
})
# standardizeSingleDocDeployment ------------------------------------------
test_that("turns appDir into appDir + appPrimarySourceDoc", {
skip_on_cran()
dir <- local_temp_app(list("foo.R" = ""))
doc <- standardizeSingleDocDeployment(file.path(dir, "foo.R"))
expect_equal(doc$appDir, normalizePath(dir))
expect_equal(doc$appPrimaryDoc, "foo.R")
})
test_that("shiny rmd deploys whole directory", {
skip_on_cran()
dir <- local_temp_app(list("foo.Rmd" = c(
"---",
"runtime: shiny",
"---"
)))
doc <- standardizeSingleDocDeployment(file.path(dir, "foo.Rmd"))
expect_equal(doc$appFiles, NULL)
})
test_that("regular rmd deploys file and dependencies", {
skip_on_cran()
dir <- local_temp_app(list(
"foo.Rmd" = c(
"---",
"resource_files: [foo.csv]",
"---"
),
"foo.csv" = ""
))
doc <- standardizeSingleDocDeployment(file.path(dir, "foo.Rmd"), quiet = TRUE)
expect_equal(doc$appFiles, c("foo.Rmd", "foo.csv"))
})
test_that("regular rmd deploys .Rprofile, if present", {
skip_on_cran()
dir <- local_temp_app(list(
"foo.Rmd" = "",
".Rprofile" = ""
))
doc <- standardizeSingleDocDeployment(file.path(dir, "foo.Rmd"), quiet = TRUE)
expect_equal(doc$appFiles, c("foo.Rmd", ".Rprofile"))
})
test_that("regular rmd deploys requirements.txt, if present", {
skip_on_cran()
dir <- local_temp_app(list(
"foo.Rmd" = "",
"requirements.txt" = ""
))
doc <- standardizeSingleDocDeployment(file.path(dir, "foo.Rmd"), quiet = TRUE)
expect_equal(doc$appFiles, c("foo.Rmd", "requirements.txt"))
})
test_that("regular rmd deploys renv.lock, if present", {
skip_on_cran()
dir <- local_temp_app(list(
"foo.Rmd" = "",
"renv.lock" = ""
))
doc <- standardizeSingleDocDeployment(file.path(dir, "foo.Rmd"), quiet = TRUE)
expect_equal(doc$appFiles, c("foo.Rmd", "renv.lock"))
})
test_that("regular html does not deploy .Rprofile", {
skip_on_cran()
dir <- local_temp_app(list(
"foo.html" = "",
".Rprofile" = ""
))
doc <- standardizeSingleDocDeployment(file.path(dir, "foo.html"), quiet = TRUE)
expect_equal(doc$appFiles, c("foo.html"))
})
test_that("regular html does not deploy requirements.txt", {
skip_on_cran()
dir <- local_temp_app(list(
"foo.html" = "",
"requirements.txt" = ""
))
doc <- standardizeSingleDocDeployment(file.path(dir, "foo.html"), quiet = TRUE)
expect_equal(doc$appFiles, c("foo.html"))
})
test_that("regular html does not deploy renv.lock", {
skip_on_cran()
dir <- local_temp_app(list(
"foo.html" = "",
"renv.lock" = ""
))
doc <- standardizeSingleDocDeployment(file.path(dir, "foo.html"), quiet = TRUE)
expect_equal(doc$appFiles, c("foo.html"))
})
test_that("other types deploy that one file", {
skip_on_cran()
dir <- local_temp_app(list("foo.R" = ""))
doc <- standardizeSingleDocDeployment(file.path(dir, "foo.R"))
expect_equal(doc$appFiles, "foo.R")
})
rsconnect/tests/testthat/test-deployments.R 0000644 0001762 0000144 00000012516 14516247550 020733 0 ustar ligges users test_that("deployments() works empty data frame if no deployments", {
dir <- local_temp_app()
out <- deployments(dir)
expect_s3_class(out, "data.frame")
expect_named(out, c(deploymentFields, "deploymentFile"))
expect_equal(nrow(out), 0)
})
test_that("combines fields across deployments", {
local_temp_config()
dir <- local_temp_app()
writeDeploymentRecord(
list(x = 1),
deploymentConfigFile(dir, "app1", "account", "server")
)
writeDeploymentRecord(
list(y = 1),
deploymentConfigFile(dir, "app2", "account", "server")
)
out <- deployments(dir, excludeOrphaned = FALSE)
expect_s3_class(out, "data.frame")
expect_named(out, c(deploymentFields, "x", "y", "deploymentFile"))
expect_equal(nrow(out), 2)
})
test_that("deployments() can filter", {
local_temp_config()
addTestServer("foo")
addTestServer("bar")
addTestAccount("foo", "foo")
addTestAccount("bar", "bar")
dir <- local_temp_app()
addTestDeployment(dir, appName = "my-app", account = "foo", server = "foo")
addTestDeployment(dir, appName = "my-app2", account = "bar", server = "bar")
out <- deployments(dir)
expect_s3_class(out, "data.frame")
expect_equal(nrow(out), 2)
out <- deployments(dir, nameFilter = "my-app")
expect_equal(nrow(out), 1)
out <- deployments(dir, serverFilter = "foo")
expect_equal(nrow(out), 1)
out <- deployments(dir, accountFilter = "foo")
expect_equal(nrow(out), 1)
})
test_that("deployments() can exclude orphans", {
dir <- local_temp_app()
addTestDeployment(dir, server = "bar1")
out <- deployments(dir)
expect_equal(nrow(out), 0)
out <- deployments(dir, excludeOrphaned = FALSE)
expect_equal(nrow(out), 1)
})
test_that("can read/write metadata", {
dir <- local_temp_app()
addTestDeployment(dir, metadata = list(meta1 = "one", meta2 = "two"))
out <- deployments(dir, excludeOrphaned = FALSE)
expect_equal(out$meta1, "one")
expect_equal(out$meta2, "two")
})
test_that("can read/write metadata having multiple values", {
dir <- local_temp_app()
addTestDeployment(dir, metadata = list(engines = c("knitr", "markdown")))
out <- deployments(dir, excludeOrphaned = FALSE)
expect_equal(nrow(out), 1)
expect_equal(out$engines, "knitr, markdown")
})
test_that("can read/write version", {
dir <- local_temp_app()
addTestDeployment(dir, version = "999")
out <- deployments(dir, excludeOrphaned = FALSE)
expect_equal(out$version, "999")
})
test_that("can read/write missing version", {
# also tests we can read files written by previous versions of package
dir <- local_temp_app()
path <- addTestDeployment(dir, version = NA)
out <- deployments(dir, excludeOrphaned = FALSE)
expect_false("version" %in% rownames(read.dcf(path)))
expect_equal(out$version, NA)
})
test_that("can read/write env vars", {
app <- local_temp_app()
addTestDeployment(app, "test1", envVars = c("TEST1", "TEST2"))
addTestDeployment(app, "test2")
deps <- deployments(app, excludeOrphaned = FALSE)
expect_equal(deps$envVars, list(c("TEST1", "TEST2"), character()))
})
test_that("can read/write empty env vars", {
# also tests we can read files written by previous versions of package
app <- local_temp_app()
# With empty character vector
path <- addTestDeployment(app, "test1", envVars = character())
deps <- deployments(app, excludeOrphaned = FALSE)
expect_false("envVars" %in% rownames(read.dcf(path)))
expect_equal(deps$envVars, list(character()))
# Or with empty string
path <- addTestDeployment(app, "test1", envVars = "")
deps <- deployments(app, excludeOrphaned = FALSE)
expect_false("envVars" %in% rownames(read.dcf(path)))
expect_equal(deps$envVars, list(character()))
})
test_that("can read/write env vars", {
app <- local_temp_app()
addTestDeployment(app, "test1", envVars = c("TEST1", "TEST2"))
addTestDeployment(app, "test2")
deps <- deployments(app, excludeOrphaned = FALSE)
expect_equal(deps$envVars, list(c("TEST1", "TEST2"), character()))
})
test_that("saveDeployment appends to global history", {
local_temp_config()
addTestServer("foo")
addTestAccount("bar", "foo")
dir <- local_temp_app()
saveDeployment(
dir,
createDeployment(
appName = "my-app",
appTitle = "",
appId = 10,
envVars = "abc", # ensure there's an envVars column in output
account = "foo",
username = "foo",
server = "bar",
version = 1
),
application = list(id = 1),
hostUrl = NULL
)
history <- read.dcf(deploymentHistoryPath())
expect_equal(nrow(history), 1)
expect_setequal(colnames(history), c(deploymentFields, "appPath"))
})
test_that("saveDeployment captures hostUrl", {
local_temp_config()
addTestServer()
addTestAccount("foo")
dir <- local_temp_app()
saveDeployment(
dir,
createDeployment(
appName = "my-app",
appTitle = "",
appId = 10,
envVars = NULL,
account = "foo",
username = "foo",
server = "example.com",
version = 1
),
application = list(id = 10)
)
out <- deployments(dir)
expect_equal(out$hostUrl, "https://example.com")
})
test_that("addToDeploymentHistory() adds needed new lines", {
local_temp_config()
expect_snapshot({
addToDeploymentHistory("path", list(x = 1))
writeLines(readLines(deploymentHistoryPath()))
addToDeploymentHistory("path", list(x = 2))
writeLines(readLines(deploymentHistoryPath()))
})
})
rsconnect/tests/testthat/test-bundlePackagePackrat.R 0000644 0001762 0000144 00000012154 14513230050 022401 0 ustar ligges users test_that("non-R apps don't have packages", {
app_dir <- local_temp_app(list(index.html = ""))
out <- snapshotPackratDependencies(app_dir)
expect_equal(out, data.frame())
})
test_that("manifest has correct data types", {
app <- local_temp_app(list("index.Rmd" = ""))
deps <- snapshotPackratDependencies(app)
expect_type(deps$description, "list")
expect_type(deps$description[[1]], "list")
})
test_that("uninstalled packages error", {
app <- local_temp_app(list("index.Rmd" = c(
"```{r}",
"library(doesntexist1)",
"library(doesntexist2)",
"```"
)))
expect_snapshot(
snapshotPackratDependencies(app),
error = TRUE,
transform = function(x) gsub('"', "'", x, fixed = TRUE)
)
})
test_that("recommended packages are snapshotted", {
app <- local_temp_app(list("index.Rmd" = c(
"```{r}",
"library(MASS)",
"```"
)))
deps <- snapshotPackratDependencies(app)
expect_true("MASS" %in% deps$Package)
})
test_that("works with BioC packages", {
skip_on_cran()
skip_on_ci()
app <- local_temp_app(list("index.Rmd" = c(
"```{r}",
"library(Biobase)",
"```"
)))
withr::local_options(repos = c(
CRAN = "https://cran.rstudio.com",
BioC = "https://bioconductor.org/packages/release/bioc"
))
deps <- snapshotPackratDependencies(app)
Biobase <- deps[deps$Package == "Biobase", ]
expect_equal(Biobase$Source, "Bioconductor")
expect_equal(Biobase$Repository, "https://bioconductor.org/packages/release/bioc")
BiocGenerics <- deps[deps$Package == "BiocGenerics", ]
expect_equal(BiocGenerics$Source, "Bioconductor")
expect_equal(BiocGenerics$Repository, "https://bioconductor.org/packages/release/bioc")
})
# addPackratSnapshot() ----------------------------------------------------
test_that("cleans up implicit dependency files", {
dir <- withr::local_tempdir()
addPackratSnapshot(dir, "rlang")
expect_equal(list.files(dir), "packrat")
})
# standardizePackratPackage -----------------------------------------
test_that("standardizeRepos adds names and normalizes paths", {
repos <- c(ONE = "https://cran1.com", "https://cran2.com/")
expect_equal(
standardizeRepos(repos),
c(ONE = "https://cran1.com", repo_2 = "https://cran2.com")
)
})
test_that("SCM records are left alone", {
bitbucket <- list(Package = "pkg", Source = "bitbucket")
gitlab <- list(Package = "pkg", Source = "gitlab")
github <- list(Package = "pkg", Source = "github")
expect_equal(
standardizePackratPackage(bitbucket),
list(Source = "bitbucket", Repository = NA_character_)
)
expect_equal(
standardizePackratPackage(gitlab),
list(Source = "gitlab", Repository = NA_character_)
)
expect_equal(
standardizePackratPackage(github),
list(Source = "github", Repository = NA_character_)
)
})
test_that("CRAN & BioC get normalized repo", {
CRAN <- list(Package = "pkg1", Source = "CRAN")
Bioconductor <- list(Package = "pkg2", Source = "Bioconductor")
packages <- data.frame(
Package = c("pkg1", "pkg2", "pkg3"),
Repository = paste0(
c("https://a.com", "https://b.com", "https://cran.com"),
"/src/contrib"
),
stringsAsFactors = FALSE
)
expect_equal(
standardizePackratPackage(CRAN, packages),
list(Source = "CRAN", Repository = "https://a.com")
)
expect_equal(
standardizePackratPackage(Bioconductor, packages),
list(Source = "Bioconductor", Repository = "https://b.com")
)
})
test_that("packages installed from other repos get correctly named", {
pkg <- list(Package = "pkg", Source = "https://test2.com")
packages <- as.matrix(data.frame(
Package = "pkg",
Version = "1.0.0",
Repository = "https://test2.com/src/contrib",
stringsAsFactors = FALSE
))
repos <- c(TEST1 = "https://test1.com", TEST2 = "https://test2.com")
expect_equal(
standardizePackratPackage(pkg, packages, repos = repos),
list(Source = "TEST2", Repository = "https://test2.com")
)
})
test_that("source packages can't be installed", {
source <- list(Package = "pkg1", Source = "source")
expect_equal(
standardizePackratPackage(source),
list(Source = NA_character_, Repository = NA_character_)
)
})
test_that("locally installed CRAN packages are handled correctly", {
packages <- as.matrix(data.frame(
Package = "pkg",
Version = "1.0.0",
Repository = "https://cran.com/src/contrib",
stringsAsFactors = FALSE
))
repos <- c(CRAN = "https://cran.com")
local <- list(
Package = "pkg",
Source = "CustomCRANLikeRepository",
Version = "1.0.0"
)
expect_equal(
standardizePackratPackage(local, packages, repos),
list(Source = "CRAN", Repository = "https://cran.com")
)
local_dev <- list(
Package = "pkg",
Source = "CustomCRANLikeRepository",
Version = "1.0.0.9000"
)
expect_equal(
standardizePackratPackage(local_dev, packages, repos),
list(Source = NA_character_, Repository = NA_character_)
)
archived <- list(
Package = "pkg2",
Source = "CustomCRANLikeRepository",
Version = "1.0.0"
)
expect_equal(
standardizePackratPackage(archived, packages, repos),
list(Source = NA_character_, Repository = NA_character_)
)
})
rsconnect/tests/testthat/test-bundlePackageRenv.R 0000644 0001762 0000144 00000014064 14536656443 021757 0 ustar ligges users # snapshotRenvDependencies() ----------------------------------------------
test_that("non-R apps don't have packages", {
skip_on_cran()
app_dir <- local_temp_app(list(index.html = ""))
out <- snapshotRenvDependencies(app_dir)
expect_equal(out, data.frame())
})
test_that("manifest has correct data types", {
skip_on_cran()
withr::local_options(renv.verbose = TRUE)
app <- local_temp_app(list("index.Rmd" = ""))
deps <- snapshotRenvDependencies(app)
expect_type(deps$description, "list")
expect_type(deps$description[[1]], "list")
})
test_that("recommended packages are snapshotted", {
skip_on_cran()
withr::local_options(renv.verbose = TRUE)
app <- local_temp_app(list("index.Rmd" = c(
"```{r}",
"library(MASS)",
"```"
)))
deps <- snapshotRenvDependencies(app)
expect_true("MASS" %in% deps$Package)
})
test_that("extra packages are snapshotted", {
skip_on_cran()
withr::local_options(renv.verbose = TRUE)
app <- local_temp_app(list("index.Rmd" = ""))
deps <- snapshotRenvDependencies(app, extraPackages = c("foreign"))
expect_true("foreign" %in% deps$Package)
})
test_that("works with BioC packages", {
skip_on_cran()
skip_on_ci()
app <- local_temp_app(list("index.R" = c(
"library(Biobase)"
)))
withr::local_options(repos = c(
CRAN = "https://cran.rstudio.com",
BioC = "https://bioconductor.org/packages/release/bioc"
))
expect_no_condition(
deps <- snapshotRenvDependencies(app),
class = "rsconnect_biocRepos"
)
Biobase <- deps[deps$Package == "Biobase", ]
expect_equal(Biobase$Source, "Bioconductor")
expect_equal(Biobase$Repository, "https://bioconductor.org/packages/release/bioc")
withr::local_options(repos = c(
CRAN = "https://cran.rstudio.com"
))
expect_condition(
deps <- snapshotRenvDependencies(app),
class = "rsconnect_biocRepos"
)
Biobase <- deps[deps$Package == "Biobase", ]
expect_equal(Biobase$Source, "Bioconductor")
expect_equal(Biobase$Repository, biocRepos(".")[[1]])
})
# https://github.com/rstudio/rsconnect/issues/968
test_that("large directories are analyzed", {
skip_on_cran()
app_dir <- local_temp_app(list("foo.R" = "library(foreign)"))
data_dir <- file.path(app_dir, "data")
dir.create(data_dir)
for (each in seq_len(1001)) {
writeLines(character(0), file.path(data_dir, paste0(each, ".txt")))
}
expect_snapshot(
deps <- snapshotRenvDependencies(app_dir)
)
expect_contains(deps$Package, "foreign")
})
# parseRenvDependencies ---------------------------------------------------
test_that("gets DESCRIPTION from renv & system libraries", {
withr::local_options(renv.verbose = FALSE)
app_dir <- local_temp_app(list("foo.R" = "library(foreign); library(MASS)"))
renv::snapshot(app_dir, prompt = FALSE)
deps <- parseRenvDependencies(app_dir)
expect_setequal(deps$Package, c("foreign", "MASS", "renv"))
expect_type(deps$description, "list")
expect_type(deps$description[[which(deps$Package == "foreign")]], "list")
expect_type(deps$description[[which(deps$Package == "MASS")]], "list")
})
test_that("errors if library and project are inconsistent", {
withr::local_options(renv.verbose = FALSE)
app_dir <- local_temp_app(list("foo.R" = "library(foreign); library(MASS)"))
renv::snapshot(app_dir, prompt = FALSE)
renv::record("MASS@0.1.1", project = app_dir)
expect_snapshot(parseRenvDependencies(app_dir), error = TRUE)
})
# standardizeRenvPackage -----------------------------------------
test_that("SCM get names translated", {
bitbucket <- list(Package = "pkg", Source = "Bitbucket")
gitlab <- list(Package = "pkg", Source = "GitLab")
github <- list(Package = "pkg", Source = "GitHub")
expect_equal(
standardizeRenvPackage(bitbucket),
list(Package = "pkg", Source = "bitbucket")
)
expect_equal(
standardizeRenvPackage(gitlab),
list(Package = "pkg", Source = "gitlab")
)
expect_equal(
standardizeRenvPackage(github),
list(Package = "pkg", Source = "github")
)
})
test_that("BioC gets normalized repo", {
Bioconductor <- list(Package = "pkg", Source = "Bioconductor")
packages <- data.frame(
Package = "pkg",
Repository = "https://b.com/src/contrib",
stringsAsFactors = FALSE
)
expect_equal(
standardizeRenvPackage(Bioconductor, packages),
list(Package = "pkg", Source = "Bioconductor", Repository = "https://b.com")
)
})
test_that("has special handling for CRAN packages", {
packages <- as.matrix(data.frame(
Package = "pkg",
Version = "1.0.0",
Repository = "https://cran.com/src/contrib",
stringsAsFactors = FALSE
))
repos <- c(CRAN = "https://cran.com")
spec <- function(version, source = "Repository", repo = "CRAN") {
list(Package = "pkg", Version = version, Source = source, Repository = repo)
}
expect_equal(
standardizeRenvPackage(spec("1.0.0"), packages, repos),
spec("1.0.0", "CRAN", "https://cran.com")
)
expect_equal(
standardizeRenvPackage(spec("1.0.0.9000"), packages, repos),
spec("1.0.0.9000", NA_character_, NA_character_)
)
})
test_that("packages installed from other repos get correctly named", {
pkg <- list(Package = "pkg", Source = "Repository", Repository = "https://test2.com")
packages <- as.matrix(data.frame(
Package = "pkg",
Version = "1.0.0",
Repository = "https://test2.com/src/contrib",
stringsAsFactors = FALSE
))
repos <- c(TEST1 = "https://test1.com", TEST2 = "https://test2.com")
expect_equal(
standardizeRenvPackage(pkg, packages, repos = repos),
list(Package = "pkg", Source = "TEST2", Repository = "https://test2.com")
)
})
test_that("source packages get NA source + repository", {
source <- list(Package = "pkg", Source = "unknown", Repository = "useless")
expect_equal(
standardizeRenvPackage(source),
list(Package = "pkg", Source = NA_character_, Repository = NA_character_)
)
})
test_that("Local packages get NA source + repository", {
source <- list(Package = "pkg", Source = "Local", Repository = "useless")
expect_equal(
standardizeRenvPackage(source),
list(Package = "pkg", Source = NA_character_, Repository = NA_character_)
)
})
rsconnect/tests/testthat/helper.R 0000644 0001762 0000144 00000007416 14516247550 016675 0 ustar ligges users showDcf <- function(df) {
write.dcf(df, stdout())
invisible()
}
# last HTTP request made
httpLastRequest <- list()
# HTTP function which just saves the result for analysis
httpTestRecorder <- function(protocol,
host,
port,
method,
path,
headers,
contentType = NULL,
file = NULL,
certificate = NULL,
writer = NULL,
timeout = NULL) {
httpLastRequest <<- list(
protocol = protocol,
host = host,
port = port,
method = method,
path = path,
headers = headers,
contentType = contentType,
file = file,
certificate = certificate,
writer = writer,
timeout = timeout
)
list(status = 200, content = "", contentType = "plain/text")
}
local_http_recorder <- function(env = caller_env()) {
withr::local_options(rsconnect.http = httpTestRecorder, .local_envir = env)
}
# Create and use a directory as temporary replacement for R_USER_CONFIG_DIR to
# avoid having tests overwrite the "official" configuration locations.
local_temp_config <- function(env = caller_env()) {
path <- withr::local_tempdir(.local_envir = env)
withr::local_envvar(R_USER_CONFIG_DIR = path, .local_envir = env)
}
local_temp_app <- function(files = list(), env = caller_env()) {
dir <- withr::local_tempdir(.local_envir = env)
for (name in names(files)) {
content <- files[[name]]
hier <- dirname(name)
if (!hier == ".") {
dir.create(file.path(dir, hier), recursive = TRUE)
}
writeLines(content, file.path(dir, name))
}
dir
}
local_shiny_bundle <- function(appName, appDir, appPrimaryDoc, python = NULL) {
appFiles <- bundleFiles(appDir)
appMetadata <- appMetadata(appDir, appFiles, appPrimaryDoc = appPrimaryDoc)
tarfile <- bundleApp(
appName,
appDir,
appFiles = appFiles,
appMetadata = appMetadata,
pythonConfig = pythonConfigurator(python),
quiet = TRUE
)
bundleTempDir <- tempfile()
utils::untar(tarfile, exdir = bundleTempDir)
unlink(tarfile)
defer(unlink(bundleTempDir, recursive = TRUE), env = caller_env())
bundleTempDir
}
# Servers and accounts ----------------------------------------------------
addTestAccount <- function(account = "ron", server = "example.com", userId = account) {
registerAccount(server, account, userId, apiKey = "123")
invisible()
}
addTestServer <- function(name = NULL, url = "https://example.com", certificate = NULL) {
if (is.null(name)) {
serverUrl <- parseHttpUrl(url)
name <- serverUrl$host
}
registerServer(
url = url,
name = name,
certificate = certificate
)
invisible()
}
addTestDeployment <- function(path,
appName = "test",
appTitle = "",
appId = "123",
account = "ron",
envVars = NULL,
username = account,
server = "example.com",
url = paste0("https://", server, "/", username, "/", appId),
hostUrl = NULL,
version = deploymentRecordVersion,
metadata = list()) {
saveDeployment(
path,
createDeployment(
appName = appName,
appTitle = appTitle,
appId = appId,
envVars = envVars,
account = account,
username = username,
server = server,
version = version
),
application = list(id = appId, url = url),
hostUrl = hostUrl,
metadata = metadata,
addToHistory = FALSE
)
}
rsconnect/tests/testthat/_snaps/ 0000755 0001762 0000144 00000000000 14516760612 016545 5 ustar ligges users rsconnect/tests/testthat/_snaps/linters.md 0000644 0001762 0000144 00000001425 14536673131 020552 0 ustar ligges users # linter warns about absolute paths and relative paths
Code
result
Output
---------------------
ShinyPresentation.Rmd
---------------------
The following lines contain absolute paths:
15: Here's some internal help: [Helpful Link](/Users/MrBurns/)
--------
server.R
--------
The following lines contain absolute paths:
15: otherFile <- read.table("~/.rsconnect-tests/local-file.txt")
The following lines contain paths to files not matching in case sensitivity:
31: file <- read.csv("data/college.txt") ## bad ['data/college.txt' -> 'data/College.txt']
Paths should be to files within the project directory.
Filepaths are case-sensitive on deployment server.
rsconnect/tests/testthat/_snaps/cookies.md 0000644 0001762 0000144 00000000613 14536673122 020524 0 ustar ligges users # Invalid cookies fail parsing
Code
cookie <- parseCookie("x=1; Path=/something/else", "/path")
Condition
Warning in `parseCookie()`:
Invalid path set for cookie on request for '/path': x=1; Path=/something/else
---
Code
cookie <- parseCookie("mycookie;")
Condition
Warning in `parseCookie()`:
Unable to parse set-cookie header: mycookie;
rsconnect/tests/testthat/_snaps/appMetadata.md 0000644 0001762 0000144 00000002173 14536673071 021317 0 ustar ligges users # quarto path is deprecated
Code
. <- appMetadata(dir, c("foo.Rmd"), quarto = "abc")
Condition
Warning:
The `quarto` argument of `deployApp()` can no longer be a path as of rsconnect 1.0.0.
i Please use quarto = `TRUE` instead instead.
# validates quarto argument
Code
appMetadata(dir, c("foo.Rmd"), quarto = 1)
Condition
Error in `appMetadata()`:
! `quarto` must be `TRUE`, `FALSE`, or `NA`, not the number 1.
# checkLayout() errors if primary doc & app.R
Code
checkAppLayout(dir, appPrimaryDoc = "myscript.R")
Condition
Error in `checkAppLayout()`:
! Project must not contain both 'app.R' and a single-file Shiny app.
# errors if no files with needed extension
Code
inferAppPrimaryDoc(NULL, "a.R", "static")
Condition
Error in `inferAppPrimaryDoc()`:
! Failed to determine `appPrimaryDoc`.
x No files matching "\\.html?$".
Code
inferAppPrimaryDoc(NULL, "a.R", "rmd-shiny")
Condition
Error in `inferAppPrimaryDoc()`:
! Failed to determine `appPrimaryDoc`.
x No files matching "\\.[Rq]md$".
rsconnect/tests/testthat/_snaps/bundlePackagePackrat.md 0000644 0001762 0000144 00000000461 14536673107 023127 0 ustar ligges users # uninstalled packages error
Code
snapshotPackratDependencies(app)
Condition
Error in `addPackratSnapshot()`:
! Failed to snapshot dependencies
Caused by error:
! Unable to retrieve package records for the following packages:
- 'doesntexist1', 'doesntexist2'
rsconnect/tests/testthat/_snaps/deployDoc.md 0000644 0001762 0000144 00000000263 14536673124 021015 0 ustar ligges users # deployDoc correctly reports bad path
Code
deployDoc("doesntexist.Rmd")
Condition
Error in `deployDoc()`:
! `doc`, "doesntexist.Rmd", does not exist.
rsconnect/tests/testthat/_snaps/bundlePackageRenv.md 0000644 0001762 0000144 00000000635 14536673122 022454 0 ustar ligges users # large directories are analyzed
Code
deps <- snapshotRenvDependencies(app_dir)
# errors if library and project are inconsistent
Code
parseRenvDependencies(app_dir)
Condition
Error in `parseRenvDependencies()`:
! Library and lockfile are out of sync
i Use renv::restore() or renv::snapshot() to synchronise
i Or ignore the lockfile by adding to your .rscignore
rsconnect/tests/testthat/_snaps/deployments.md 0000644 0001762 0000144 00000000615 14536673124 021437 0 ustar ligges users # addToDeploymentHistory() adds needed new lines
Code
addToDeploymentHistory("path", list(x = 1))
writeLines(readLines(deploymentHistoryPath()))
Output
x: 1
appPath: path
Code
addToDeploymentHistory("path", list(x = 2))
writeLines(readLines(deploymentHistoryPath()))
Output
x: 2
appPath: path
x: 1
appPath: path
rsconnect/tests/testthat/_snaps/applications.md 0000644 0001762 0000144 00000000237 14536673063 021564 0 ustar ligges users # syncAppMetadata deletes deployment records if needed
Code
syncAppMetadata(app)
Message
Deleting deployment record for deleted app 123.
rsconnect/tests/testthat/_snaps/ide.md 0000644 0001762 0000144 00000000600 14536673136 017632 0 ustar ligges users # getAppById() fails where expected
Code
getAppById("123", "susan", "unknown", "unknown.com")
Condition
Error in `getAppById()`:
! Can't find server with url "unknown.com".
Code
getAppById("123", "robert", "unknown", "https://example.com")
Condition
Error in `getAppById()`:
! Can't find account "robert" on server "example.com".
rsconnect/tests/testthat/_snaps/lint.md 0000644 0001762 0000144 00000000710 14536673131 020034 0 ustar ligges users # lints give have useful print method
Code
lint(test_path("test-rmd-bad-case"))
Output
---------
index.Rmd
---------
The following lines contain paths to files not matching in case sensitivity:
29:  ['img/rstudio.svg' -> 'img/RStudio.svg']
Filepaths are case-sensitive on deployment server.
Code
lint(test_path("shinyapp-appR"))
Output
No problems found
rsconnect/tests/testthat/_snaps/http-libcurl.md 0000644 0001762 0000144 00000000273 14536673130 021502 0 ustar ligges users # can trace JSON
Code
. <- POST_JSON(service, list(), "", list(a = 1, b = 2))
Output
<< {
<< "a": 1,
<< "b": 2
<< }
>> {"a":[1],"b":[2]}
rsconnect/tests/testthat/_snaps/deploymentTarget.md 0000644 0001762 0000144 00000010774 14536673126 022434 0 ustar ligges users # errors if no accounts
Code
findDeploymentTarget()
Condition
Error:
! No accounts registered.
i Call `rsconnect::setAccountInfo()` to register an account.
# errors if unknown account or server
Code
findDeploymentTarget(server = "unknown")
Condition
Error:
! Can't find any accounts with `server` = "unknown".
i Known servers are "bar".
Code
findDeploymentTarget(account = "john")
Condition
Error:
! Can't find any accounts with `account` = "john".
i Available account names: "foo".
# errors if no previous deployments and multiple accounts
Code
findDeploymentTarget(app_dir)
Condition
Error:
! Found multiple accounts.
Please disambiguate by setting `server` and/or `account`.
i Available servers: "foo1" and "foo2".
i Available account names: "ron".
Code
findDeploymentTarget(app_dir, appName = "test")
Condition
Error:
! Found multiple accounts.
Please disambiguate by setting `server` and/or `account`.
i Available servers: "foo1" and "foo2".
i Available account names: "ron".
# handles accounts if only server specified
Code
findDeploymentTarget(app_dir, server = "foo")
Condition
Error:
! Found multiple accounts for `server` = "foo".
Please disambiguate by setting `account`.
i Known account names are "john" and "ron".
# errors/prompts if multiple deployments
Code
findDeploymentTarget(app_dir, appName = "test")
Condition
Error:
! This directory has been previously deployed in multiple places.
Please use `appName`, `server` or `account` to disambiguate.
Known applications:
* test (server: server1.com / username: ron):
* test (server: server2.com / username: ron):
Code
findDeploymentTarget(app_dir)
Condition
Error:
! This directory has been previously deployed in multiple places.
Please use `appName`, `server` or `account` to disambiguate.
Known applications:
* test (server: server1.com / username: ron):
* test (server: server2.com / username: ron):
---
Code
target <- findDeploymentTarget(app_dir)
Message
This directory has been previously deployed in multiple places.
Which deployment do you want to use?
1: test (server: server1.com / username: ron):
2: test (server: server2.com / username: ron):
Selection: 1
# succeeds if there are no deployments and a single account
Code
findDeploymentTarget(app_dir)
Condition
Error:
! Discovered a previously deployed app named "remotename"
(View it at )
i Set `forceUpdate = TRUE` to update it.
i Supply a unique `appName` to deploy a new application.
# shouldUpdateApp errors when non-interactive
Code
shouldUpdateApp(app, "my_app-1")
Condition
Error:
! Discovered a previously deployed app named "my_app"
(View it at )
i Set `forceUpdate = TRUE` to update it.
i Supply a unique `appName` to deploy a new application.
# shouldUpdateApp handles 3 options
Code
one <- shouldUpdateApp(app, "my_app-1")
Message
Discovered a previously deployed app named "my_app"
(View it at )
What do you want to do?
1: Update the existing app.
2: Create a new app with automatically generated name ("my_app-1").
3: Abort this deployment and supply a custom `appName`.
Selection: 1
Code
two <- shouldUpdateApp(app, "my_app-1")
Message
Discovered a previously deployed app named "my_app"
(View it at )
What do you want to do?
1: Update the existing app.
2: Create a new app with automatically generated name ("my_app-1").
3: Abort this deployment and supply a custom `appName`.
Selection: 2
Code
three <- shouldUpdateApp(app, "my_app-1")
Message
Discovered a previously deployed app named "my_app"
(View it at )
What do you want to do?
1: Update the existing app.
2: Create a new app with automatically generated name ("my_app-1").
3: Abort this deployment and supply a custom `appName`.
Selection: 3
Condition
Error:
! Quitting...
rsconnect/tests/testthat/_snaps/appDependencies.md 0000644 0001762 0000144 00000001713 14536673066 022170 0 ustar ligges users # infers correct packages for each source
Code
inferRPackageDependencies(simulateMetadata("rmd-static"))
Output
[1] "rmarkdown"
Code
inferRPackageDependencies(simulateMetadata("rmd-static", hasParameters = TRUE))
Output
[1] "rmarkdown" "shiny"
Code
inferRPackageDependencies(simulateMetadata("quarto-static"))
Output
[1] "rmarkdown"
Code
inferRPackageDependencies(simulateMetadata("quarto-shiny"))
Output
[1] "rmarkdown" "shiny"
Code
inferRPackageDependencies(simulateMetadata("rmd-shiny"))
Output
[1] "rmarkdown" "shiny"
Code
inferRPackageDependencies(simulateMetadata("shiny"))
Output
[1] "shiny"
Code
inferRPackageDependencies(simulateMetadata("api"))
Output
[1] "plumber"
Code
inferRPackageDependencies(simulateMetadata("api", documentsHavePython = TRUE))
Output
[1] "plumber" "reticulate"
rsconnect/tests/testthat/_snaps/http.md 0000644 0001762 0000144 00000004600 14536673130 020046 0 ustar ligges users # non-libCurl methods are deprecated
Code
. <- httpFunction()
Condition
Warning:
The `rsconnect.http` option was deprecated in rsconnect 1.0.0.
i It should no longer be necessary to set this option
i If the default http handler doesn't work for you, please file an issue at
# authHeaders() picks correct method based on supplied fields
Code
str(authHeaders(list(secret = "123"), url, "GET"))
Output
List of 3
$ Date : chr "Thu, 09 Mar 2023 14:29:00 GMT"
$ X-Auth-Signature : chr "YmJiMjM1Y2E5MjFlNGFkOTMxZjQxNzU4NGQ1ZTk3MzYyYzg1YjcyMzUyMzhlYTY4Y2UxMjI1MzJkZWE1MDA3NQ==; version=1"
$ X-Content-Checksum: chr "d41d8cd98f00b204e9800998ecf8427e"
Code
str(authHeaders(list(private_key = key), url, "GET"))
Output
List of 3
$ Date : chr "Thu, 09 Mar 2023 14:29:00 GMT"
$ X-Auth-Signature : chr "tqz4HGcSmuWKIGzIj42OEkwYZQzfJBdrUynlBQKSEEok2zMFZwsgEpEzU8PzpoeMEmcX5+Cr1IuDLLASz0ivAQ=="
$ X-Content-Checksum: chr "1B2M2Y8AsgTpgAmY7PhCfg=="
# includes body in error if available
Code
handleResponse(resp_text)
Condition
Error:
! failed with HTTP status 400
Failed
Code
handleResponse(resp_json)
Condition
Error:
! failed with HTTP status 400
failed
Code
handleResponse(resp_html)
Condition
Error:
! failed with HTTP status 400
Failed
# but still gives got error if no body
Code
handleResponse(resp_text)
Condition
Error:
! failed with HTTP status 400
Code
handleResponse(resp_json)
Condition
Error:
! failed with HTTP status 400
Unexpected json response:
Code
handleResponse(resp_html)
Condition
Error:
! failed with HTTP status 400
# errors contain method
Code
GET(service, list(), path = "status/404")
Condition
Error in `GET()`:
! failed with HTTP status 404
Code
POST(service, list(), path = "status/403")
Condition
Error in `POST()`:
! failed with HTTP status 403
rsconnect/tests/testthat/_snaps/bundlePython.md 0000644 0001762 0000144 00000000354 14536673114 021546 0 ustar ligges users # throws error if environment.py fails
Code
inferPythonEnv(".", pythonPathOrSkip())
Condition
Error in `inferPythonEnv()`:
! Error reading requirements.txt: [Errno 13] Permission denied: './requirements.txt'
rsconnect/tests/testthat/_snaps/writeManifest.md 0000644 0001762 0000144 00000000353 14536673172 021717 0 ustar ligges users # Deploying a Quarto project without Quarto is an error
Code
makeManifest(appDir)
Condition
Error in `quartoInspect()`:
! `quarto` not found.
i Check that it is installed and available on your `PATH`.
rsconnect/tests/testthat/_snaps/deployApp.md 0000644 0001762 0000144 00000004401 14536673123 021025 0 ustar ligges users # appDir must be an existing directory
Code
deployApp(1)
Condition
Error in `deployApp()`:
! `appDir` must be a single string, not the number 1.
Code
deployApp("doesntexist")
Condition
Error in `deployApp()`:
! `appDir`, "doesntexist", does not exist.
# single document appDir is deprecated
Code
deployApp("foo.Rmd")
Condition
Warning:
The `appDir` argument of `deployApp()` takes a directory, not a document, as of rsconnect 1.0.0.
i Please use `deployDoc()` instead.
Error in `deployDoc()`:
! `doc`, "foo.Rmd", does not exist.
# appPrimaryDoc must exist, if supplied
Code
deployApp(dir, appPrimaryDoc = c("foo.Rmd", "bar.Rmd"))
Condition
Error in `deployApp()`:
! `appPrimaryDoc` must be a single string, not a character vector.
Code
deployApp(dir, appPrimaryDoc = "foo.Rmd")
Condition
Error in `deployApp()`:
! `appPrimaryDoc` not found inside `appDir`
# startup scripts are logged by default
Code
runStartupScripts(".")
Message
i Running ./.rsconnect_profile
# needsVisibilityChange() errors for cloud
Code
needsVisibilityChange("posit.cloud", appVisibility = "public")
Condition
Error in `needsVisibilityChange()`:
! Can't change cloud app visiblity from `deployApp()`.
i Please change on posit.cloud instead.
# deployHook executes function if set
Code
. <- runDeploymentHook("PATH", "rsconnect.pre.deploy", verbose = TRUE)
Output
Invoking `rsconnect.pre.deploy` hook
# applicationDeleted() errors or prompts as needed
Code
applicationDeleted(client, target, app)
Condition
Error in `applicationDeleted()`:
! Failed to find existing application on server; it's probably been deleted.
i Use `forgetDeployment()` to remove outdated record and try again.
i Or use `applications()` to see other applications you have on the server.
---
Code
. <- applicationDeleted(client, target, app)
Message
Failed to find existing application on server; it's probably been deleted.
What do you want to do?
1: Give up and try again later
2: Delete existing deployment & create a new app
Selection: 2
rsconnect/tests/testthat/_snaps/account-find.md 0000644 0001762 0000144 00000004017 14536673063 021450 0 ustar ligges users # validates its arguments
Code
findAccount(1, NULL)
Condition
Error:
! `account` must be a single string or `NULL`, not the number 1.
Code
findAccount(NULL, 1)
Condition
Error:
! `server` must be a single string or `NULL`, not the number 1.
# error if no accounts
Code
findAccount()
Condition
Error:
! No accounts registered.
i Call `rsconnect::setAccountInfo()` to register an account.
# error if no matching account
Code
findAccount("unknown", NULL)
Condition
Error:
! Can't find any accounts with `account` = "unknown".
i Available account names: "albert".
Code
findAccount(NULL, "unknown")
Condition
Error:
! Can't find any accounts with `server` = "unknown".
i Known servers are "example.com".
Code
findAccount("unknown", "unknown")
Condition
Error:
! Can't find account with `name` = "unknown" and `server` = "unknown"
i Call `accounts()` to see available options.
# error if ambiguous accounts in non-interactive environment
Code
findAccount()
Condition
Error:
! Found multiple accounts.
Please disambiguate by setting `server` and/or `account`.
i Available servers: "x" and "y".
i Available account names: "a" and "b".
Code
findAccount("a", NULL)
Condition
Error:
! Found multiple accounts for `account` = "a".
Please disambiguate by setting `server`.
i Available servers: "x" and "y".
Code
findAccount(NULL, "y")
Condition
Error:
! Found multiple accounts for `server` = "y".
Please disambiguate by setting `account`.
i Known account names are "a" and "b".
# prompted to pick account in interactive environment
Code
out <- findAccount()
Message
Found multiple accounts.
Which one do you want to use?
1: server: x / username: a
2: server: y / username: a
3: server: y / username: b
Selection: 2
rsconnect/tests/testthat/_snaps/secret.md 0000644 0001762 0000144 00000000313 14536673131 020352 0 ustar ligges users # print and str obfuscate output
Code
x <- secret("THIS IS MY PASSWORD: foo")
x
Output
[1] "THIS I... (redacted)"
Code
str(x)
Output
THIS I... (redacted)
rsconnect/tests/testthat/_snaps/bundlePackage.md 0000644 0001762 0000144 00000002372 14536673102 021617 0 ustar ligges users # can snapshot deps with renv
Code
pkgs <- bundlePackages(app_dir)
Message
i Capturing R dependencies with renv
v Found 2 dependencies
# can snapshot deps with packrat (option)
Code
pkgs <- bundlePackages(app_dir)
Message
i Capturing R dependencies with packrat
v Found 2 dependencies
# can snapshot deps with packrat (env var)
Code
pkgs <- bundlePackages(app_dir)
Message
i Capturing R dependencies with packrat
v Found 2 dependencies
# can capture deps from renv lockfile
Code
pkgs <- bundlePackages(app_dir)
Message
i Capturing R dependencies from renv.lock
v Found 3 dependencies
# can capture deps with packrat even when renv lockfile present
Code
pkgs <- bundlePackages(app_dir)
Message
i Capturing R dependencies with packrat
v Found 2 dependencies
# error if can't find source
Code
. <- bundlePackages(app_dir)
Message
i Capturing R dependencies with renv
v Found 1 dependency
Condition
Error:
! All packages must be installed from a reproducible location.
x Can't re-install packages installed from source: shiny.
i See `rsconnect::appDependencies()` for more details.
rsconnect/tests/testthat/_snaps/bundleFiles.md 0000644 0001762 0000144 00000005602 14536673076 021337 0 ustar ligges users # can read all files from directory
Code
listDeploymentFiles(dir)
Condition
Error:
! No content to deploy.
x `appDir` is empty.
# can read selected files from directory
Code
out <- listDeploymentFiles(dir, c("b.R", "c.R"))
Condition
Warning:
All files listed in `appFiles` must exist.
Problems: 'c.R'
---
Code
listDeploymentFiles(dir, character())
Condition
Error:
! No content to deploy.
x `appFiles` didn't match any files in `appDir`.
# can read selected files from manifest
Code
out <- listDeploymentFiles(dir, appFileManifest = file.path(dir, "manifest"))
Condition
Warning:
All files listed in `appFileManifest` must exist.
Problems: 'c.R'
---
Code
listDeploymentFiles(dir, appFileManifest = file.path(dir, "manifest"))
Condition
Error:
! No content to deploy.
x `appFileManifest` contains no usable files.
# checks its inputs
Code
listDeploymentFiles(dir)
Condition
Error:
! No content to deploy.
x `appDir` is empty.
Code
listDeploymentFiles(dir, appFiles = "a.R", appFileManifest = "b.R")
Condition
Error:
! Must specify at most one of `appFiles` and `appFileManifest`
Code
listDeploymentFiles(dir, appFiles = 1)
Condition
Error:
! `appFiles` must be a character vector or `NULL`, not the number 1.
Code
listDeploymentFiles(dir, appFileManifest = "doestexist")
Condition
Error:
! `appFileManifest`, "doestexist", does not exist.
# drops drops non-existent files with warning
Code
out <- explodeFiles(dir, c("a", "d"))
Condition
Warning:
All files listed in `appFiles` must exist.
Problems: 'd'
# generate nicely formatted messages
Code
explodeFiles(dir, c("a", "b"))
Condition
Error in `enforceBundleLimits()`:
! `appDir` ('') is too large to be deployed.
x The maximum number of files is 1.
x This directory contains at least 2 files.
i Remove some files or adjust the rsconnect.max.bundle.files option.
Code
explodeFiles(dir, "c")
Condition
Error in `enforceBundleLimits()`:
! `appDir` ('') is too large to be deployed.
x The maximum size is 5 bytes.
x This directory is at least ?? bytes.
i Remove some files or adjust the rsconnect.max.bundle.size option.
# detectLongNames produces informative warning if needed
Code
detectLongNames(dir, 0)
Condition
Warning:
The bundle contains files with user/group names longer than 0.
x Files: 'a.r', 'b.r', and 'c.r'
x Long user and group names cause the internal R tar implementation to produce invalid archives
i Set the `rsconnect.tar` option or the `RSCONNECT_TAR` environment variable to the path to a tar executable.
rsconnect/tests/testthat/_snaps/accounts.md 0000644 0001762 0000144 00000001101 14536673062 020703 0 ustar ligges users # secrets are hidden from casual inspection
Code
accountInfo("1")$secret
Output
[1] "SECRET... (redacted)"
Code
accountInfo("2")$private_key
Output
[1] "SECRET... (redacted)"
Code
accountInfo("3")$apiKey
Output
[1] "SECRET... (redacted)"
# setAccountInfo() gives nice error on bad copy and paste
Code
setAccountInfo("name", "token", "")
Condition
Error in `setAccountInfo()`:
! You've copied and pasted the wrong thing.
i Either click 'Show secret' or 'Copy to clipboard'.
rsconnect/tests/testthat/_snaps/appMetadata-quarto.md 0000644 0001762 0000144 00000000316 14536673075 022631 0 ustar ligges users # quartoInspect requires quarto
Code
quartoInspect()
Condition
Error in `quartoInspect()`:
! `quarto` not found.
i Check that it is installed and available on your `PATH`.
rsconnect/tests/testthat/_snaps/servers-deprec.md 0000644 0001762 0000144 00000000367 14536673132 022030 0 ustar ligges users # addConnectServer is deprecated
Code
addConnectServer("https://colorado.posit.co/rsc", quiet = TRUE)
Condition
Warning:
`addConnectServer()` was deprecated in rsconnect 1.0.0.
i Please use `addServer()` instead.
rsconnect/tests/testthat/_snaps/bundle.md 0000644 0001762 0000144 00000000634 14536673106 020346 0 ustar ligges users # removes renv/packrat activation
Code
tweakRProfile(path)
writeLines(readLines(path))
Output
# Modified by rsconnect package on
# Line 1
# renv initialization disabled in published application
# source("renv/activate.R")
# Line 3
# Packrat initialization disabled in published application
# source("packrat/init.R")
# Line 5
rsconnect/tests/testthat/_snaps/servers.md 0000644 0001762 0000144 00000005346 14536673133 020573 0 ustar ligges users # servers() redacts the certificate
Code
servers()
Output
name url certificate
1 cert_test_a https://localhost:4567/ -----B... (redacted)
2 shinyapps.io https://api.shinyapps.io/v1 Amazon... (redacted)
3 posit.cloud https://api.posit.cloud/v1 Amazon... (redacted)
# serverInfo() redacts the certificate
Code
str(serverInfo("posit.cloud"))
Output
List of 3
$ name : chr "posit.cloud"
$ url : chr "https://api.posit.cloud/v1"
$ certificate: Amazon... (redacted)
Code
str(serverInfo("shinyapps.io"))
Output
List of 3
$ name : chr "shinyapps.io"
$ url : chr "https://api.shinyapps.io/v1"
$ certificate: Amazon... (redacted)
# serverInfo() errors if server not present
Code
serverInfo("foo")
Condition
Error in `findServer()`:
! Can't find `server` with name "foo".
i Known servers are "shinyapps.io" and "posit.cloud".
# addServer() errors if url not a connect server
Code
addServer(url)
Condition
Error in `addServer()`:
! `url` does not appear to be a Posit Connect server.
# addServer() and addServerCertificate() inform about their actions
Code
addServer("https://example.com", validate = FALSE)
Message
Server 'example.com' added successfully: https://example.com
Code
addServerCertificate("example.com", certificate = cert)
Message
Certificate added to server 'example.com'
# certificates can't be attached to plain http servers
Code
addServerCertificate("test", cert)
Condition
Error in `addServerCertificate()`:
! Certificates may only be attached to servers that use the HTTPS protocol.
i Specify an HTTPS URL for the server, or omit the certificate.
# findServer() errors if no servers
Code
findServer()
Condition
Error in `findServer()`:
! No local servers have been registered
# findServer() errors/prompts of multiple servers present
Code
findServer()
Condition
Error in `findServer()`:
! Multiple servers found.
i Use `server` to pick one of "myserver" and "yourserver".
---
Code
out <- findServer()
Message
Multiple servers found.
Which one do you want to use?
1: myserver
2: yourserver
Selection: 2
# findServer checks server name
Code
findServer(1)
Condition
Error:
! `server` must be a single string, not the number 1.
Code
findServer("foo")
Condition
Error in `findServer()`:
! Can't find `server` with name "foo".
i Known servers are "shinyapps.io" and "posit.cloud".
rsconnect/tests/testthat/_snaps/deployments-find.md 0000644 0001762 0000144 00000002023 14536673123 022347 0 ustar ligges users # error when no deployments and no accounts
Code
findDeployment(app, appName = "placeholder")
Condition
Error in `accountInfo()`:
! No accounts registered.
i Call `rsconnect::setAccountInfo()` to register an account.
# disambiguates multiple deployments
Code
findDeployment(app)
Condition
Error:
! This directory has been previously deployed in multiple places.
Please use `appName`, `server` or `account` to disambiguate.
Known applications:
* test1 (server: example.com / username: ron):
* test2 (server: example.com / username: ron):
---
Code
dep <- findDeployment(app)
Message
This directory has been previously deployed in multiple places.
Which deployment do you want to use?
1: test1 (server: example.com / username: ron):
2: test2 (server: example.com / username: ron):
Selection: 2
rsconnect/tests/testthat/test-shinyApp/ 0000755 0001762 0000144 00000000000 14467166424 020040 5 ustar ligges users rsconnect/tests/testthat/test-shinyApp/test-shinyApp.tar.gz 0000644 0001762 0000144 00000015660 14467166424 023747 0 ustar ligges users \msFWL12U!A $HIlNbD;[ @I^=HYc֭YE3==3tOV:[Fyf>g4 㿶8ƶv\{~&QSʹ[ڡ|1 3YL_Q杣V}%JCuQi4Q,N;ˋ2ҾѾٷI4ITPu_(c~^~1n~d#>o_@ab*.~cYlE˱6_1 et\PA C/~>ս7^ojբ 勦E.+uf܉O[۶ؚ]Dk;Þ=9֣X<gI`U_()mB,,e\tzehhb%U.BDImF(oD
7
ɠ.TD#%|8xOWL.o0w*.J@p]IieQ]PINC3#
rf8]y>U͢&+YѼ"S:e2]N/U;{^d, {W"
ޤO_U\$Ο -+V
[[YݒAW?,0 Xeo _&gg?zcW\sA 굊wqxT5+HBX8QqqK r@B7:8+eR|s~jrq>9:i+PEy^zN8T:{ iZE&Xn #|q%E2;*M}F oJho4=7}i}{@'h "P8/(U)#q&˓ӌ:,*6X+ @+
ELzew XFu; cKLr
dB"@JozP푱an{'t0z+B:emxM"GG&Z;djӁ@
_{ h6$jSoD]i=5o;q |.3,]7}ww0O/PlNb[iz qfJVru_4Zoz~Ki Q"M ӷict B;nJ; ^:C^ez9lS^i48WЮ\ʾwe ߝ㆓tɢŲk<ݰ^_Qre?[@g+ cA Q w] x4Dx+T5ǎ?=MG2KX^ZVQ]}(ر,2+M?/"|syI7 n$Bkv
h*AYkxh6#CvȂ_9 ((7dLփ> +L|9U[Baі
W?=1t˼3܄~B i^lp #ui6
%쇊L^: e 2/W[* UN)OR{
FCZZ>)=7=h
L>WKݞm7 EѯjߒK&J]\^*~{Up* |6PLNPi $ ܣH$
;"1C1u$e ;n| i>5̐[5*x dHͪ3)x85[Er1Jf"D?YhERX 3onU7rUfʳa0JQc?a 4#eŒ itA-@hB9 ^FDXD s."4 M1+Qjakm
5Γfa5ꊈ$Ɓ_FCN݆ W
4R;M44 ' &1z@Z#˸zG4LV^NrT^J_J4$ME [Fk^n[ !o⛷5Рe-:}t 憕e(Ђ"<:k Ϟ<j/m:kു@^x!HP|{BӚYgn~U6 }-#?PtEdx`t[Yg{p m,hX?p\zZw$u pp&GwY;bس{ٯa
av(a\ qHtq|jAVi, |.T QcP/Tpp .K#H-:/Ӥ+p
ّrDٹx*KU
ZaH>3 x4
/@0wbA%Yt. #/ؙE+x7/uNg//eT*~/er/,1+so@M& 4eHKI@8
] BxDoڟ6"YDjK/ޮ\g
9i_Ý:!(k,% 6ǣ&4] Yfm)) _ޫ|){N(7i<XiAi*?~`(ĩjl<n 5ǹГeF% AS,f٭u)vNh= Kql%dX*Xºi #,[sg&Z)22TI4t]f@WWtD"К;HV6, !?f/0˴Cy?S͡|{ O@([%*oQ!@C*9mkαvP)`2uV;+vjY$t*KQnfwo ތ]*~I.b8yk;Xd'Zem+fOUMs
t g)cW }x0@9
z :GSi N=w7TٽсqooH TJfRO|' e\rr$虄 ζ `g@%
SpZMaҩUR>\)Yo:[bib,Q@Ȑ:O~X *Y~(6C;zc-+մ>#ZpRX$n a6srH+>_d;)k6K~ QAB )DIţ8Qz(⓴\ )z{d_l'7"Fv5>ˀγ$0e6vQ@E`\ɳfK*z/2t!W\96Gt\f[ILD,љZQoBi2ӳP?\;3`1
^ "nFӇ|~Tn{A>eLc3t14W%D | CC'`h[+Zk]e(
M!լ|:JJ+dU[{Z[ZB2ZKz)F˘:u6l"=gۻ"øBÆr'/ Du' BU=u&d5J( r.ieZryQS:>5;DjX BU%(m( G|ń79 #4[R& ̢A6f]NosΩ .9=:}(ȵDeDIJ030bC[>[$ nIz9b Y>>ԻTɲxL
0_Mn8w:%DϣBijE$d6;HZǨq f#ӡJiz~75 t)1h"JG[m5tT ]; @HF"U,)je50zh F "o1q[ʑt&{
Y w&:=yV;D=nL%S/"}69B Pp-+
2,E6YXl =k%0t rC| X8. v
Єpji-\KVe؍k<:z< {#]{.u X= v8\
r:vp s? +o T `,~~ `NsۛxÉ;`|Ñ l"F hr2 g> X1+Sow?ܿ z }=qIx ?=Fǎ0,?w:-±-s!Tx8jWC (g m: G W(E B4:Q>p(Irn룵R@
hȅX
E&FZM>hTQU^F>h T;y #=x2Ӡi8Hj|8x ṗa<&|ngerj?x; x;T Y&{| ΝcFCXJěNwjs z~` ca>'5 F#}wҷxxcc,1tDк3z+n @o#?
S x>@sa{&C B_f%rzmS]se=Ήxhg ;SC/t# jxFvST 0dC C^'Dxas8
YˇYlXA8 {( x@\\{@xiH#s<ǽAqlОcg2 @B̽H~|1?ܽ?g4 ~*̃邞J3!~ѵg`-[Z
*ZG:CW(IO|T WVe"λVΘNT>qozї!8-7=Q:_ n"UV[ѣh$/SqBBjqE\b&2ppc?:(\ѓTŘ>>>>^A&~ h rsconnect/tests/testthat/packages/ 0000755 0001762 0000144 00000000000 14536677712 017052 5 ustar ligges users rsconnect/tests/testthat/packages/latin1package/ 0000755 0001762 0000144 00000000000 14513230050 021525 5 ustar ligges users rsconnect/tests/testthat/packages/latin1package/NAMESPACE 0000644 0001762 0000144 00000000037 14513230050 022744 0 ustar ligges users exportPattern("^[[:alpha:]]+")
rsconnect/tests/testthat/packages/latin1package/man/ 0000755 0001762 0000144 00000000000 14513230050 022300 5 ustar ligges users rsconnect/tests/testthat/packages/latin1package/man/hello.Rd 0000644 0001762 0000144 00000000200 14513230050 023662 0 ustar ligges users \name{hello}
\alias{hello}
\title{Hello, World!}
\usage{
hello()
}
\description{
Prints 'Hello, world!'.
}
\examples{
hello()
}
rsconnect/tests/testthat/packages/latin1package/DESCRIPTION 0000644 0001762 0000144 00000000357 14513230050 023240 0 ustar ligges users Package: latin1package
Type: Package
Title: Provides some funky characters.
Version: 0.1.0
Author: Jens Frhling
Maintainer: Jens Frhling
Description: a test package
License: GPL-2
Encoding: latin1
LazyData: true
rsconnect/tests/testthat/packages/latin1package/R/ 0000755 0001762 0000144 00000000000 14513230050 021726 5 ustar ligges users rsconnect/tests/testthat/packages/latin1package/R/hello.R 0000644 0001762 0000144 00000000061 14513230050 023151 0 ustar ligges users hello <- function() {
print("Hello, world!")
}
rsconnect/tests/testthat/packages/utf8package/ 0000755 0001762 0000144 00000000000 14513230050 021223 5 ustar ligges users rsconnect/tests/testthat/packages/utf8package/NAMESPACE 0000644 0001762 0000144 00000000037 14513230050 022442 0 ustar ligges users exportPattern("^[[:alpha:]]+")
rsconnect/tests/testthat/packages/utf8package/man/ 0000755 0001762 0000144 00000000000 14513230050 021776 5 ustar ligges users rsconnect/tests/testthat/packages/utf8package/man/hello.Rd 0000644 0001762 0000144 00000000200 14513230050 023360 0 ustar ligges users \name{hello}
\alias{hello}
\title{Hello, World!}
\usage{
hello()
}
\description{
Prints 'Hello, world!'.
}
\examples{
hello()
}
rsconnect/tests/testthat/packages/utf8package/DESCRIPTION 0000644 0001762 0000144 00000000356 14513230050 022735 0 ustar ligges users Package: utf8package
Type: Package
Title: Provides some funky characters.
Version: 0.1.0
Author: Jens Fröhling
Maintainer: Jens Fröhling
Description: a test package
License: GPL-2
Encoding: UTF-8
LazyData: true
rsconnect/tests/testthat/packages/utf8package/R/ 0000755 0001762 0000144 00000000000 14513230050 021424 5 ustar ligges users rsconnect/tests/testthat/packages/utf8package/R/hello.R 0000644 0001762 0000144 00000000061 14513230050 022647 0 ustar ligges users hello <- function() {
print("Hello, world!")
}
rsconnect/tests/testthat/packages/windows1251package/ 0000755 0001762 0000144 00000000000 14513230050 022340 5 ustar ligges users rsconnect/tests/testthat/packages/windows1251package/NAMESPACE 0000644 0001762 0000144 00000000037 14513230050 023557 0 ustar ligges users exportPattern("^[[:alpha:]]+")
rsconnect/tests/testthat/packages/windows1251package/man/ 0000755 0001762 0000144 00000000000 14513230050 023113 5 ustar ligges users rsconnect/tests/testthat/packages/windows1251package/man/hello.Rd 0000644 0001762 0000144 00000000200 14513230050 024475 0 ustar ligges users \name{hello}
\alias{hello}
\title{Hello, World!}
\usage{
hello()
}
\description{
Prints 'Hello, world!'.
}
\examples{
hello()
}
rsconnect/tests/testthat/packages/windows1251package/DESCRIPTION 0000644 0001762 0000144 00000000366 14513230050 024053 0 ustar ligges users Package: windows1251package
Type: Package
Title: Provides some funky characters.
Version: 0.1.0
Author:
Maintainer:
Description: a test package
License: GPL-2
Encoding: Windows-1251
LazyData: true
rsconnect/tests/testthat/packages/windows1251package/R/ 0000755 0001762 0000144 00000000000 14513230050 022541 5 ustar ligges users rsconnect/tests/testthat/packages/windows1251package/R/hello.R 0000644 0001762 0000144 00000000061 14513230050 023764 0 ustar ligges users hello <- function() {
print("Hello, world!")
}
rsconnect/tests/testthat/test-servers.R 0000644 0001762 0000144 00000013734 14513230050 020044 0 ustar ligges users test_that("servers() can return 0 row data frame", {
local_temp_config()
out <- servers(local = TRUE)
expect_equal(nrow(out), 0)
expect_named(out, c("name", "url", "certificate"))
})
test_that("servers() redacts the certificate", {
local_temp_config()
# add a server with a sample certificate
addTestServer(
url = "https://localhost:4567/",
name = "cert_test_a",
certificate = test_path("certs/sample.crt")
)
expect_snapshot(servers())
})
test_that("serverInfo() redacts the certificate", {
expect_snapshot({
str(serverInfo("posit.cloud"))
str(serverInfo("shinyapps.io"))
})
})
test_that("serverInfo() errors if server not present", {
local_temp_config()
expect_snapshot(serverInfo("foo"), error = TRUE)
})
test_that("normalizes connect urls", {
expected <- "https://myserver.com/__api__"
expect_equal(ensureConnectServerUrl("https://myserver.com"), expected)
expect_equal(ensureConnectServerUrl("https://myserver.com/"), expected)
expect_equal(ensureConnectServerUrl("https://myserver.com/__api__"), expected)
expect_equal(ensureConnectServerUrl("https://myserver.com/__api__/"), expected)
})
# addServer ---------------------------------------------------------------
test_that("addServer() name defaults to hostname & port of url", {
expect_equal(serverName("https://example.com/abc"), "example.com")
expect_equal(serverName("https://example.com:8787/abc"), "example.com:8787")
})
test_that("addServer() normalises url", {
skip_on_cran()
local_temp_config()
addServer("connect.posit.it", name = "connect", quiet = TRUE)
info <- serverInfo("connect")
expect_equal(info$url, "https://connect.posit.it/__api__")
})
test_that("addServer() errors if url not a connect server", {
local_temp_config()
service <- httpbin_service()
url <- buildHttpUrl(service)
expect_snapshot(addServer(url), error = TRUE)
})
test_that("addServer() and addServerCertificate() inform about their actions", {
local_temp_config()
cert <- test_path("certs/sample.crt")
expect_snapshot({
addServer("https://example.com", validate = FALSE)
addServerCertificate("example.com", certificate = cert)
})
})
test_that("can save certificates", {
local_temp_config()
addTestServer("test", certificate = test_path("certs/sample.crt"))
info <- serverInfo("test")
certLines <- paste(readLines(test_path("certs/sample.crt")), collapse = "\n")
expect_equal(info$certificate, secret(certLines))
})
test_that("can add certificates after creation", {
local_temp_config()
addTestServer("test")
addServerCertificate("test",
certificate = test_path("certs/sample.crt"),
quiet = TRUE
)
info <- serverInfo("test")
certLines <- paste(readLines(test_path("certs/sample.crt")), collapse = "\n")
expect_equal(info$certificate, secret(certLines))
})
test_that("can store multiple certificates can exist in one dcf", {
local_temp_config()
addTestServer("test", certificate = test_path("certs/two-cas.crt"))
info <- serverInfo("test")
certLines <- paste(readLines(test_path("certs/two-cas.crt")), collapse = "\n")
expect_equal(info$certificate, secret(certLines))
})
test_that("certificates can't be attached to plain http servers", {
local_temp_config()
addTestServer("test", "http://example.com")
cert <- test_path("certs/sample.crt")
expect_snapshot(addServerCertificate("test", cert), error = TRUE)
})
# cloud servers -----------------------------------------------------------
test_that("All hosted product names are identified as cloud", {
expect_true(isCloudServer("shinyapps.io"))
expect_true(isCloudServer("rstudio.cloud"))
expect_true(isCloudServer("posit.cloud"))
expect_false(isCloudServer("connect.internal"))
})
test_that("All hosted product names are identified as cloud", {
checkCloudServer("shinyapps.io")
checkCloudServer("rstudio.cloud")
checkCloudServer("posit.cloud")
expect_error(checkCloudServer("connect.internal"))
})
test_that("only shinyapps.io is identified as shinyapps.io", {
expect_true(isShinyappsServer("shinyapps.io"))
expect_false(isShinyappsServer("rstudio.cloud"))
expect_false(isShinyappsServer("posit.cloud"))
expect_false(isShinyappsServer("connect.internal"))
})
test_that("only shinyapps.io is identified as shinyapps.io", {
checkShinyappsServer("shinyapps.io")
expect_error(checkShinyappsServer("rstudio.cloud"))
expect_error(checkShinyappsServer("posit.cloud"))
expect_error(checkShinyappsServer("connect.internal"))
})
test_that("predefined servers includes cloud and shinyapps", {
local_temp_config()
out <- servers()
expect_equal(nrow(out), 2)
expect_named(out, c("name", "url", "certificate"))
expect_setequal(out$name, c("posit.cloud", "shinyapps.io"))
})
test_that("predefined servers includes rstudio.cloud if needed", {
local_temp_config()
addTestAccount("john", "rstudio.cloud")
expect_true("rstudio.cloud" %in% servers()$name)
})
test_that("cloud server info matches name given if valid", {
local_temp_config()
addTestAccount("john", "rstudio.cloud")
rstudioServer <- serverInfo("rstudio.cloud")
expect_equal(rstudioServer$name, "rstudio.cloud")
})
# findServer --------------------------------------------------------------
test_that("findServer() errors if no servers", {
local_temp_config()
expect_snapshot(findServer(), error = TRUE)
})
test_that("findServer() picks server if only one present", {
local_mocked_bindings(servers = function(...) {
data.frame(name = "myserver", stringsAsFactors = FALSE)
})
expect_equal(findServer(), "myserver")
})
test_that("findServer() errors/prompts of multiple servers present", {
local_mocked_bindings(servers = function(...) {
data.frame(name = c("myserver", "yourserver"), stringsAsFactors = FALSE)
})
expect_snapshot(findServer(), error = TRUE)
simulate_user_input(2)
expect_snapshot(out <- findServer())
expect_equal(out, "yourserver")
})
test_that("findServer checks server name", {
local_temp_config()
expect_snapshot(error = TRUE, {
findServer(1)
findServer("foo")
})
})
rsconnect/tests/testthat/test-rmd-bad-case/ 0000755 0001762 0000144 00000000000 14513230050 020437 5 ustar ligges users rsconnect/tests/testthat/test-rmd-bad-case/img/ 0000755 0001762 0000144 00000000000 14513230050 021213 5 ustar ligges users rsconnect/tests/testthat/test-rmd-bad-case/img/RStudio.svg 0000644 0001762 0000144 00000000127 14513230050 023325 0 ustar ligges users
rsconnect/tests/testthat/test-rmd-bad-case/index.Rmd 0000644 0001762 0000144 00000001570 14513230050 022215 0 ustar ligges users ---
title: "rmarkdown with bad link case"
---
One of the embedded images uses `img/rstudio.svg` even though the on-disk filename
is `img/RStudio.svg`. This will render fine on a Mac, for example, but will err
when rendered on Linux.
The Mac filesystem is case-preserving, but case-insensitive. The Linux
filesystem is case-sensitive.
The IDE and `rsconnect::deployDoc` attempt to deploy the as-linked filenames.
With both `img/rstudio.svg` and `img/RStudio.svg` links, the bundle has two copies of
the SVG!
You can use `rsconnect::deployApp` directly to see the lint error in the R
console:
```r
rsconnect::deployApp(
appDir = getwd(),
appFiles = c("index.Rmd", "img/RStudio.svg"))
```
And now, the links!
This one (line 29) is all lower-case and should trigger the error.
This one is mixed-case and matches the on-disk filename.
rsconnect/tests/testthat/test-client.R 0000644 0001762 0000144 00000001144 14513230050 017621 0 ustar ligges users test_that("cloud accounts create cloud clients", {
account <- list(server = "posit.cloud")
client <- clientForAccount(account)
expect_equal(client$service(), "posit.cloud")
})
test_that("shinyapps accounts create shinyapps clients", {
account <- list(server = "shinyapps.io")
client <- clientForAccount(account)
expect_equal(client$service(), "shinyapps.io")
})
test_that("connect accounts create connect clients", {
local_temp_config()
addTestServer("example.com")
account <- list(server = "example.com")
client <- clientForAccount(account)
expect_equal(client$service(), "connect")
})
rsconnect/tests/testthat/shinyapp-simple/ 0000755 0001762 0000144 00000000000 14536677712 020416 5 ustar ligges users rsconnect/tests/testthat/shinyapp-simple/server.R 0000644 0001762 0000144 00000000313 14467166424 022040 0 ustar ligges users library(shiny)
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
dist <- rnorm(input$obs)
hist(dist)
})
output$obs <- renderText({paste(input$obs, "\n", input$obs)})
})
rsconnect/tests/testthat/shinyapp-simple/ui.R 0000644 0001762 0000144 00000000412 14467166424 021147 0 ustar ligges users library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Hello, Shiny!"),
sidebarPanel(
sliderInput("obs", "Number of observations:",
min = 1,
max = 1000,
value = 500)),
mainPanel(
plotOutput("distPlot")))
)
rsconnect/tests/testthat/test-deployApp.R 0000644 0001762 0000144 00000006007 14516247550 020323 0 ustar ligges users test_that("appDir must be an existing directory", {
expect_snapshot(error = TRUE, {
deployApp(1)
deployApp("doesntexist")
})
})
test_that("single document appDir is deprecated", {
skip_on_cran()
expect_snapshot(error = TRUE, {
deployApp("foo.Rmd")
})
})
test_that("appPrimaryDoc must exist, if supplied", {
skip_on_cran()
dir <- local_temp_app()
expect_snapshot(error = TRUE, {
deployApp(dir, appPrimaryDoc = c("foo.Rmd", "bar.Rmd"))
deployApp(dir, appPrimaryDoc = "foo.Rmd")
})
})
test_that("startup scripts are logged by default", {
dir <- local_temp_app()
withr::local_dir(dir)
writeLines("1 + 1", file.path(dir, ".rsconnect_profile"))
expect_snapshot(runStartupScripts("."))
})
# record directory --------------------------------------------------------
test_that("findRecordPath() uses recordDir, then appPrimaryDoc, then appDir", {
expect_equal(findRecordPath("a"), "a")
expect_equal(findRecordPath("a", recordDir = "b"), "b")
expect_equal(findRecordPath("a", appPrimaryDoc = "c"), "a/c")
})
# app visibility ----------------------------------------------------------
test_that("needsVisibilityChange() returns FALSE when no change needed", {
dummyApp <- function(visibility) {
list(
deployment = list(
properties = list(
application.visibility = visibility
)
)
)
}
expect_false(needsVisibilityChange("connect.com"))
expect_false(needsVisibilityChange("shinyapps.io", dummyApp("public"), NULL))
expect_false(needsVisibilityChange("shinyapps.io", dummyApp("public"), "public"))
expect_true(needsVisibilityChange("shinyapps.io", dummyApp(NULL), "private"))
expect_true(needsVisibilityChange("shinyapps.io", dummyApp("public"), "private"))
})
test_that("needsVisibilityChange() errors for cloud", {
expect_snapshot(error = TRUE,
needsVisibilityChange("posit.cloud", appVisibility = "public")
)
})
test_that("deployHook executes function if set", {
withr::local_options(rsconnect.pre.deploy = NULL)
expect_equal(
runDeploymentHook("PATH", "rsconnect.pre.deploy"),
NULL
)
withr::local_options(rsconnect.pre.deploy = function(path) path)
expect_equal(
runDeploymentHook("PATH", "rsconnect.pre.deploy"),
"PATH"
)
expect_snapshot(
. <- runDeploymentHook("PATH", "rsconnect.pre.deploy", verbose = TRUE)
)
})
# deleted apps ------------------------------------------------------------
test_that("applicationDeleted() errors or prompts as needed", {
local_temp_config()
addTestServer("s")
addTestAccount("a", "s")
app <- local_temp_app()
addTestDeployment(app, appName = "name", account = "a", server = "s")
target <- createDeployment("name", "title", "id", NULL, "a", "a", "s", 1)
client <- list(createApplication = function(...) NULL)
expect_snapshot(applicationDeleted(client, target, app), error = TRUE)
expect_length(dir(app, recursive = TRUE), 1)
simulate_user_input(2)
expect_snapshot(. <- applicationDeleted(client, target, app))
expect_length(dir(app, recursive = TRUE), 0)
})
rsconnect/tests/testthat/test-deploymentTarget.R 0000644 0001762 0000144 00000042134 14522164250 021706 0 ustar ligges users test_that("errors if no accounts", {
local_temp_config()
expect_snapshot(findDeploymentTarget(), error = TRUE)
})
test_that("errors if unknown account or server", {
local_temp_config()
addTestServer("bar")
addTestAccount("foo", "bar")
expect_snapshot(error = TRUE, {
findDeploymentTarget(server = "unknown")
findDeploymentTarget(account = "john")
})
})
test_that("errors if no previous deployments and multiple accounts", {
local_temp_config()
addTestServer("foo1")
addTestServer("foo2")
addTestAccount("ron", "foo1")
addTestAccount("ron", "foo2")
app_dir <- withr::local_tempdir()
file.create(file.path(app_dir, "app.R"))
expect_snapshot(error = TRUE, {
findDeploymentTarget(app_dir)
findDeploymentTarget(app_dir, appName = "test")
})
})
test_that("uses appId given a local deployment record; created by a local account", {
# Demonstrates that the deployment record is sufficient without a call to
# the remote server.
local_temp_config()
addTestServer("local")
addTestAccount("leslie", "local")
app_dir <- withr::local_tempdir()
addTestDeployment(app_dir, appName = "local-record", appId = "the-appid", account = "leslie", server = "local")
target <- findDeploymentTarget(app_dir, appId = "the-appid")
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "leslie")
expect_equal(accountDetails$server, "local")
expect_equal(deployment$appId, "the-appid")
expect_equal(deployment$name, "local-record")
expect_equal(deployment$username, "leslie")
expect_equal(deployment$account, "leslie")
expect_equal(deployment$server, "local")
})
test_that("uses appId given a local deployment record; created by a collaborator", {
# Demonstrates that the target account does not need to be the account that
# created the deployment record. The deployment record is sufficient without
# a call to the remote server.
local_temp_config()
addTestServer("local")
addTestAccount("leslie", "local")
app_dir <- withr::local_tempdir()
addTestDeployment(app_dir, appName = "local-record", appId = "the-appid", account = "ron", server = "local")
target <- findDeploymentTarget(app_dir, appId = "the-appid")
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "leslie")
expect_equal(accountDetails$server, "local")
expect_equal(deployment$appId, "the-appid")
expect_equal(deployment$name, "local-record")
expect_equal(deployment$username, "ron")
expect_equal(deployment$account, "ron")
expect_equal(deployment$server, "local")
})
test_that("uses appId without local deployment record; created by local account", {
local_temp_config()
addTestServer("local")
addTestAccount("leslie", "local")
local_mocked_bindings(
getApplication = function(...) data.frame(
id = "the-appid",
name = "remote-record",
owner_username = "leslie",
stringsAsFactors = FALSE
)
)
app_dir <- withr::local_tempdir()
target <- findDeploymentTarget(app_dir, appId = "the-appid")
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "leslie")
expect_equal(accountDetails$server, "local")
expect_equal(deployment$appId, "the-appid")
expect_equal(deployment$name, "remote-record")
expect_equal(deployment$username, "leslie")
expect_equal(deployment$account, "leslie")
expect_equal(deployment$server, "local")
})
test_that("uses appId without local deployment record; created by collaborator", {
local_temp_config()
addTestServer("local")
addTestAccount("leslie", "local")
app_dir <- withr::local_tempdir()
local_mocked_bindings(
getApplication = function(...) data.frame(
id = "the-appid",
name = "remote-record",
owner_username = "ron",
stringsAsFactors = FALSE
)
)
target <- findDeploymentTarget(app_dir, appId = "the-appid")
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "leslie")
expect_equal(accountDetails$server, "local")
expect_equal(deployment$appId, "the-appid")
expect_equal(deployment$name, "remote-record")
expect_equal(deployment$username, "ron")
# note: account+server does not correspond to the "ron" account, but this is
# the best we can do, as we do not have the original deployment record.
expect_equal(deployment$account, "leslie")
expect_equal(deployment$server, "local")
})
test_that("handles accounts if only server specified", {
local_temp_config()
addTestServer("foo")
addTestAccount("ron", "foo")
addTestAccount("john", "foo")
local_mocked_bindings(getAppByName = function(...) NULL)
app_dir <- withr::local_tempdir()
file.create(file.path(app_dir, "app.R"))
expect_snapshot(findDeploymentTarget(app_dir, server = "foo"), error = TRUE)
target <- findDeploymentTarget(
app_dir,
server = "foo",
account = "ron"
)
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "ron")
expect_equal(accountDetails$server, "foo")
expect_equal(deployment$username, "ron")
expect_equal(deployment$account, "ron")
expect_equal(deployment$server, "foo")
})
test_that("errors/prompts if multiple deployments", {
local_temp_config()
addTestServer("server1.com")
addTestServer("server2.com")
addTestAccount("ron", "server1.com")
addTestAccount("ron", "server2.com")
app_dir <- withr::local_tempdir()
addTestDeployment(app_dir, server = "server1.com")
addTestDeployment(app_dir, server = "server2.com")
expect_snapshot(error = TRUE, {
findDeploymentTarget(app_dir, appName = "test")
findDeploymentTarget(app_dir)
})
simulate_user_input(1)
expect_snapshot(target <- findDeploymentTarget(app_dir))
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "ron")
expect_equal(accountDetails$server, "server1.com")
expect_equal(deployment$name, "test")
})
test_that("succeeds if there's a single existing deployment", {
local_temp_config()
addTestServer("example.com")
addTestAccount("ron")
app_dir <- withr::local_tempdir()
addTestDeployment(
app_dir,
appName = "test",
appId = "1",
username = "ron",
account = "ron",
server = "example.com",
version = "999"
)
expect_equal(nrow(deployments(app_dir, accountFilter = "ron", serverFilter = "example.com")), 1)
expect_equal(nrow(deployments(app_dir)), 1)
target <- findDeploymentTarget(app_dir)
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "ron")
expect_equal(accountDetails$server, "example.com")
expect_equal(deployment$appId, "1")
expect_equal(deployment$name, "test")
expect_equal(deployment$username, "ron")
expect_equal(deployment$account, "ron")
expect_equal(deployment$server, "example.com")
expect_equal(deployment$version, "999")
target <- findDeploymentTarget(app_dir, appName = "test")
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "ron")
expect_equal(accountDetails$server, "example.com")
expect_equal(deployment$appId, "1")
expect_equal(deployment$name, "test")
expect_equal(deployment$username, "ron")
expect_equal(deployment$account, "ron")
expect_equal(deployment$server, "example.com")
expect_equal(deployment$version, "999")
})
test_that("appId is used even when name does not match", {
local_temp_config()
addTestServer()
addTestAccount("ron")
app_dir <- withr::local_tempdir()
addTestDeployment(app_dir, appName = "test", appId = "1", username = "ron")
addTestDeployment(app_dir, appName = "second", appId = "2", username = "ron")
target <- findDeploymentTarget(app_dir, appName = "mismatched", appId = "1")
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "ron")
expect_equal(accountDetails$server, "example.com")
expect_equal(deployment$appId, "1")
})
test_that("new title overrides existing title", {
local_temp_config()
addTestServer()
addTestAccount("ron")
app_dir <- withr::local_tempdir()
addTestDeployment(app_dir, appTitle = "old title")
target <- findDeploymentTarget(app_dir)
deployment <- target$deployment
expect_equal(deployment$title, "old title")
target <- findDeploymentTarget(app_dir, appTitle = "new title")
deployment <- target$deployment
expect_equal(deployment$title, "new title")
})
test_that("new env vars overrides existing", {
local_temp_config()
app <- local_temp_app()
addTestServer()
addTestAccount()
addTestDeployment(app, envVars = "TEST1")
target <- findDeploymentTarget(app)
deployment <- target$deployment
expect_equal(deployment$envVars, "TEST1")
target <- findDeploymentTarget(app, envVars = "TEST2")
deployment <- target$deployment
expect_equal(deployment$envVars, "TEST2")
# And check that it works with vectors
addTestDeployment(app, envVars = c("TEST1", "TEST2"))
target <- findDeploymentTarget(app)
deployment <- target$deployment
expect_equal(deployment$envVars, c("TEST1", "TEST2"))
target <- findDeploymentTarget(app, envVars = "TEST2")
deployment <- target$deployment
expect_equal(deployment$envVars, "TEST2")
})
test_that("empty character vector removes env vars", {
local_temp_config()
app <- local_temp_app()
addTestServer()
addTestAccount()
addTestDeployment(app, envVars = "TEST1")
target <- findDeploymentTarget(app, envVars = character())
deployment <- target$deployment
expect_equal(deployment$envVars, character())
})
test_that("succeeds if there are no deployments and a single account", {
local_temp_config()
addTestServer()
addTestAccount("ron")
local_mocked_bindings(
getAppByName = function(...) data.frame(
name = "remotename",
url = "app-url",
stringsAsFactors = FALSE
)
)
app_dir <- dirCreate(file.path(withr::local_tempdir(), "my_app"))
expect_snapshot(error = TRUE, {
findDeploymentTarget(app_dir)
})
simulate_user_input(1)
target <- findDeploymentTarget(app_dir)
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "ron")
expect_equal(accountDetails$server, "example.com")
expect_equal(deployment$name, "remotename")
expect_equal(deployment$username, "ron")
expect_equal(deployment$account, "ron")
expect_equal(deployment$server, "example.com")
target <- findDeploymentTarget(app_dir, forceUpdate = TRUE)
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "ron")
expect_equal(accountDetails$server, "example.com")
expect_equal(deployment$name, "remotename")
expect_equal(deployment$username, "ron")
expect_equal(deployment$account, "ron")
expect_equal(deployment$server, "example.com")
target <- findDeploymentTarget(app_dir, envVars = c("TEST1", "TEST2"), forceUpdate = TRUE)
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "ron")
expect_equal(accountDetails$server, "example.com")
expect_equal(deployment$name, "remotename")
expect_equal(deployment$username, "ron")
expect_equal(deployment$account, "ron")
expect_equal(deployment$server, "example.com")
expect_equal(deployment$envVars, c("TEST1", "TEST2"))
target <- findDeploymentTarget(app_dir, appName = "foo", forceUpdate = TRUE)
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(accountDetails$name, "ron")
expect_equal(accountDetails$server, "example.com")
expect_equal(deployment$name, "remotename")
expect_equal(deployment$username, "ron")
expect_equal(deployment$account, "ron")
expect_equal(deployment$server, "example.com")
})
test_that("default title is the empty string", {
local_temp_config()
addTestServer()
addTestAccount("ron")
local_mocked_bindings(
getAppByName = function(...) data.frame(
name = "remotename",
url = "app-url",
stringsAsFactors = FALSE
)
)
app_dir <- withr::local_tempdir()
target <- findDeploymentTarget(app_dir, forceUpdate = TRUE)
deployment <- target$deployment
expect_equal(deployment$title, "")
})
confirm_existing_app_used <- function(server) {
local_temp_config()
addTestServer()
addTestAccount("ron", server = server)
local_mocked_bindings(getAppByName = function(...) data.frame(
name = "my_app",
id = 123,
url = "http://example.com/test",
stringsAsFactors = FALSE
),
shouldUpdateApp = function(...) TRUE
)
app_dir <- withr::local_tempdir()
target <- findDeploymentTarget(app_dir, appName = "my_app", server = server)
deployment <- target$deployment
expect_equal(deployment$appId, 123)
}
test_that("can find existing application on server & use it", {
confirm_existing_app_used("example.com")
})
test_that("can find existing application on shinyapps.io & use it", {
confirm_existing_app_used("shinyapps.io")
})
confirm_existing_app_not_used <- function(server) {
local_temp_config()
addTestServer()
addTestAccount("ron", server = server)
local_mocked_bindings(getAppByName = function(...) data.frame(
name = "my_app",
id = 123,
url = "http://example.com/test",
stringsAsFactors = FALSE
),
shouldUpdateApp = function(...) FALSE
)
app_dir <- withr::local_tempdir()
target <- findDeploymentTarget(app_dir, appName = "my_app", server = server)
deployment <- target$deployment
expect_equal(deployment$name, "my_app-1")
expect_equal(deployment$appId, NULL)
}
test_that("can find existing application on server & not use it", {
confirm_existing_app_not_used("example.com")
})
test_that("can find existing application on shinyapps.io & not use it", {
confirm_existing_app_not_used("shinyapps.io")
})
# defaultAppName ----------------------------------------------------------
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("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")
long_name <- strrep("abcd", 64 / 4)
expect_equal(defaultAppName(paste(long_name, "..."), "shinyapps.io"), long_name)
})
# helpers -----------------------------------------------------------------
test_that("shouldUpdateApp errors when non-interactive", {
app <- list(name = "my_app", url = "https://example.com")
expect_snapshot(shouldUpdateApp(app, "my_app-1"), error = TRUE)
})
test_that("forceUpdate shortcircuits shouldUpdateApp", {
expect_true(shouldUpdateApp(forceUpdate = TRUE))
})
test_that("shouldUpdateApp handles 3 options", {
app <- list(name = "my_app", url = "https://example.com")
simulate_user_input(c(1, 2, 3))
expect_snapshot(error = TRUE, {
one <- shouldUpdateApp(app, "my_app-1")
two <- shouldUpdateApp(app, "my_app-1")
three <- shouldUpdateApp(app, "my_app-1")
})
expect_equal(one, TRUE)
expect_equal(two, FALSE)
})
test_that("findUnique always returns unique name", {
expect_equal(findUnique("x", c("x", "y")), "x-1")
expect_equal(findUnique("x", c("x", "x-1")), "x-2")
expect_equal(findUnique("x", c("x", "x-1", "x-2")), "x-3")
})
test_that("createDeploymentFromApplication promotes fields", {
expect_equal(createDeploymentFromApplication(
application = list(
id = "1",
name = "app-name",
title = "app-title",
owner_username = "alice.username"
),
accountDetails = list(
name = "alice",
server = "example.com"
)
), list(
name = "app-name",
title = "app-title",
envVars = NULL,
appId = "1",
username = "alice.username",
account = "alice",
server = "example.com",
version = deploymentRecordVersion
))
})
test_that("updateDeployment updates fields", {
expect_equal(updateDeployment(
list(
name = "app-name",
title = "app-title",
envVars = NULL,
appId = "1",
username = "alice.username",
account = "alice",
server = "example.com",
version = deploymentRecordVersion
),
appTitle = "updated-title",
envVars = c("VAR-NAME")
), list(
name = "app-name",
title = "updated-title",
envVars = c("VAR-NAME"),
appId = "1",
username = "alice.username",
account = "alice",
server = "example.com",
version = deploymentRecordVersion
))
})
test_that("updateDeployment ignores NULL updates", {
expect_equal(updateDeployment(
list(
name = "app-name",
title = "app-title",
envVars = c("VAR-NAME"),
appId = "1",
username = "alice.username",
account = "alice",
server = "example.com",
version = deploymentRecordVersion
),
appTitle = NULL,
envVars = NULL
), list(
name = "app-name",
title = "app-title",
envVars = c("VAR-NAME"),
appId = "1",
username = "alice.username",
account = "alice",
server = "example.com",
version = deploymentRecordVersion
))
})
rsconnect/tests/testthat/test-utils.R 0000644 0001762 0000144 00000006211 14513230050 017503 0 ustar ligges users test_that("file_path_sans_ext removes extensions", {
# extensions are removed.
expect_equal(
file_path_sans_ext(c("noext", "extension.ext", "doubledot..ext")),
c("noext", "extension", "doubledot.")
)
# compression extensions are removed first (when explicitly requested).
expect_equal(
file_path_sans_ext(
c(
"noext",
"extension.ext",
"doubledot..ext",
"compressed.gz",
"compressext.ext.bz2",
"compressdoubledot..ext.xz"
),
compression = TRUE
),
c(
"noext",
"extension",
"doubledot.",
"compressed",
"compressext",
"compressdoubledot."
)
)
})
# rbind_fill --------------------------------------------------------------
test_that("adds missing columns", {
dfs <- list(data.frame(x = 1), data.frame(y = 2))
out <- rbind_fill(dfs)
expect_equal(out, data.frame(x = c(1, NA), y = c(NA, 2)))
})
test_that("order of col_names has preference", {
dfs <- list(data.frame(y = 1, x = 2))
out <- rbind_fill(dfs, c("x", "y"))
expect_equal(out, data.frame(x = 2, y = 1))
})
test_that("uses col_names if no inputs", {
expect_equal(rbind_fill(list()), data.frame())
expect_equal(
rbind_fill(list(), c("x", "y")),
data.frame(x = logical(), y = logical())
)
})
test_that("can work with empty data frames", {
out <- rbind_fill(list(data.frame(x = 1), data.frame()))
expect_equal(out, data.frame(x = 1))
})
# hashing -----------------------------------------------------------------
test_that("we can hash an empty file", {
emptyFile <- withr::local_tempfile()
file.create(emptyFile)
# computed by openssl::md5("")
expect_equal(fileMD5(emptyFile), "d41d8cd98f00b204e9800998ecf8427e")
expect_equal(fileMD5(NULL), "d41d8cd98f00b204e9800998ecf8427e")
})
test_that("we can hash a file with well known contents", {
path <- withr::local_tempfile()
# Open in binary mode so the contents are identical on all platforms
# (otherwise the file contains a \n on Unix and \r\n on Windows, which
# hash differently)
con <- file(path, open = "wb")
writeLines("go bananas!", con)
close(con)
expect_equal(fileMD5(path), "52d2daa95d288f3c01e4d4d87f85727e")
})
test_that("truthy is truthy", {
# fallback-to-default checks
expect_false(truthy(c()))
expect_true(truthy(c(), default = TRUE))
expect_false(truthy(NA))
expect_true(truthy(NA, default = TRUE))
# true value checks
expect_true(truthy(TRUE, default = FALSE))
expect_true(truthy("TRUE", default = FALSE))
expect_true(truthy("True", default = FALSE))
expect_true(truthy("true", default = FALSE))
expect_true(truthy("T", default = FALSE))
expect_true(truthy("1", default = FALSE))
expect_true(truthy(1, default = FALSE))
expect_true(truthy(42, default = FALSE))
# false value checks
expect_false(truthy(FALSE, default = TRUE))
expect_false(truthy("FALSE", default = TRUE))
expect_false(truthy("False", default = TRUE))
expect_false(truthy("false", default = TRUE))
expect_false(truthy("F", default = TRUE))
expect_false(truthy("0", default = TRUE))
expect_false(truthy(0, default = TRUE))
expect_false(truthy("nonsense", default = TRUE))
})
rsconnect/tests/testthat/test-lint.R 0000644 0001762 0000144 00000001176 14513230050 017316 0 ustar ligges users test_that("lints give have useful print method", {
expect_snapshot({
lint(test_path("test-rmd-bad-case"))
lint(test_path("shinyapp-appR"))
})
})
test_that("The linter believes that the Shiny example apps are okay", {
examples <- list.files(system.file("examples", package = "shiny"), full.names = TRUE)
if (length(examples)) {
results <- lapply(examples, lint)
expect_output(lints <- lapply(results, print))
lapply(lints, function(project) {
lapply(project, function(file) {
lapply(file, function(linter) {
expect_true(length(linter$indices) == 0)
})
})
})
}
})
rsconnect/tests/testthat/test-ide.R 0000644 0001762 0000144 00000005517 14513230050 017114 0 ustar ligges users test_that("validateServerUrl() returns expected", {
skip_on_cran()
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()
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)
})
test_that("validateConnectUrl() normalises urls", {
skip_on_cran()
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)
})
test_that("validateConnectUrl() follows redirects", {
skip_on_cran()
api_url <- "https://connect.posit.it:443/__api__"
expect_equal(validateConnectUrl("http://connect.posit.it")$url, api_url)
})
test_that("getAppById() fails where expected", {
local_temp_config()
addTestServer()
addTestAccount("susan")
expect_snapshot(error = TRUE, {
getAppById("123", "susan", "unknown", "unknown.com")
getAppById("123", "robert", "unknown", "https://example.com")
})
})
current_user_service <- function() {
app <- env_cache(
cache,
"current_user_app",
{
json_app <- webfakes::new_app()
json_app$use(webfakes::mw_json())
json_app$get("/users/current", function(req, res) {
res$set_status(200L)$send_json(list(username = jsonlite::unbox("susan")))
})
app <- webfakes::new_app_process(json_app)
}
)
parseHttpUrl(app$url())
}
test_that("getUserFromRawToken having a single matching server", {
local_temp_config()
service <- current_user_service()
url <- buildHttpUrl(service)
addTestServer("test", url = url)
token <- generateToken()
claimUrl <- url
user <- getUserFromRawToken(claimUrl, token$token, token$private_key)
expect_equal(user$username, "susan")
})
test_that("getUserFromRawToken having multiple matching servers", {
local_temp_config()
service <- current_user_service()
url <- buildHttpUrl(service)
addTestServer("test", url = url)
addTestServer("test2", url = url)
token <- generateToken()
claimUrl <- url
user <- getUserFromRawToken(claimUrl, token$token, token$private_key)
expect_equal(user$username, "susan")
})
rsconnect/tests/testthat/test-account-find.R 0000644 0001762 0000144 00000003070 14513230050 020715 0 ustar ligges users test_that("validates its arguments", {
expect_snapshot(error = TRUE, {
findAccount(1, NULL)
findAccount(NULL, 1)
})
})
test_that("error if no accounts", {
local_temp_config()
expect_snapshot(findAccount(), error = TRUE)
})
test_that("error if no matching account", {
local_temp_config()
addTestServer()
addTestAccount("albert")
expect_snapshot(error = TRUE, {
findAccount("unknown", NULL)
findAccount(NULL, "unknown")
findAccount("unknown", "unknown")
})
})
test_that("error if ambiguous accounts in non-interactive environment", {
local_temp_config()
addTestServer("a")
addTestServer("b")
addTestAccount("a", "x")
addTestAccount("a", "y")
addTestAccount("b", "y")
expect_snapshot(error = TRUE, {
findAccount()
findAccount("a", NULL)
findAccount(NULL, "y")
})
})
test_that("prompted to pick account in interactive environment", {
local_temp_config()
addTestServer("a")
addTestServer("b")
addTestAccount("a", "x")
addTestAccount("a", "y")
addTestAccount("b", "y")
simulate_user_input(2)
expect_snapshot(out <- findAccount())
expect_equal(out, list(name = "a", server = "y"))
})
test_that("returns account + server when uniquely identified", {
local_temp_config()
addTestServer("a")
addTestAccount("a", "x")
expect_equal(findAccount(NULL, NULL), list(name = "a", server = "x"))
expect_equal(findAccount("a", NULL), list(name = "a", server = "x"))
expect_equal(findAccount(NULL, "x"), list(name = "a", server = "x"))
expect_equal(findAccount("a", "x"), list(name = "a", server = "x"))
})
rsconnect/tests/testthat/test-deploySite.R 0000644 0001762 0000144 00000001225 14513230050 020464 0 ustar ligges users test_that("can extract quarto metadata", {
skip_if_no_quarto()
app <- local_temp_app(list(`_quarto.yaml` = c(
"project:",
" type: website",
"",
"website:",
" title: 'website-quarto'"
)))
site <- quartoSite(app)
expect_equal(site$title, "website-quarto")
expect_equal(site$output_dir, normalizePath(file.path(app, "_site")))
})
test_that("can extract rmarkdown metadata", {
app <- local_temp_app(list(
`_site.yml` = 'name: "my-website"'
))
site <- rmarkdownSite(app)
expect_equal(site$name, "my-website")
expect_equal(site$title, NULL)
expect_equal(site$output_dir, normalizePath(file.path(app, "_site")))
})
rsconnect/tests/testthat/test-http-rcurl.R 0000644 0001762 0000144 00000000415 14513230050 020447 0 ustar ligges users test_that("basic HTTP methods work", {
skip_if_not_installed("RCurl")
withr::local_options(rsconnect.http = "rcurl", lifecycle_verbosity = "quiet")
test_http_GET()
test_http_POST_JSON()
test_http_POST_empty()
test_http_POST_file()
test_http_headers()
})
rsconnect/tests/testthat/renv-recommended/ 0000755 0001762 0000144 00000000000 14513230050 020475 5 ustar ligges users rsconnect/tests/testthat/renv-recommended/dependences.R 0000644 0001762 0000144 00000000016 14513230050 023072 0 ustar ligges users library(MASS)
rsconnect/tests/testthat/renv-recommended/renv.lock 0000644 0001762 0000144 00000002023 14513230050 022316 0 ustar ligges users {
"R": {
"Version": "4.2.1",
"Repositories": [
{
"Name": "CRAN",
"URL": "https://cran.rstudio.com"
},
{
"Name": "BioC",
"URL": "https://bioconductor.org/packages/3.16/bioc"
}
]
},
"Packages": {
"MASS": {
"Package": "MASS",
"Version": "7.3-58.3",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"grDevices",
"graphics",
"methods",
"stats",
"utils"
],
"Hash": "9586b552d57f5516fe4d25398c1bacd6"
},
"renv": {
"Package": "renv",
"Version": "0.17.2",
"Source": "Repository",
"Repository": "CRAN",
"RemoteType": "standard",
"RemotePkgRef": "renv",
"RemoteRef": "renv",
"RemoteRepos": "https://cran.rstudio.com",
"RemotePkgPlatform": "aarch64-apple-darwin20",
"RemoteSha": "0.17.2",
"Requirements": [
"utils"
],
"Hash": "aaf3c7f769695266a2113db67a25148b"
}
}
}
rsconnect/tests/testthat/test-reticulate-rmds/ 0000755 0001762 0000144 00000000000 14536673141 021345 5 ustar ligges users rsconnect/tests/testthat/test-reticulate-rmds/implicit.Rmd 0000644 0001762 0000144 00000000271 14467166424 023627 0 ustar ligges users ---
title: An example R Markdown document that uses reticulate to run python content
---
```{python}
from pprint import pprint
xs = range(10)
pprint([(x, x**2, x**3) for x in xs])
```
rsconnect/tests/testthat/test-reticulate-rmds/index.Rmd 0000644 0001762 0000144 00000000331 14467166424 023121 0 ustar ligges users ---
title: An example R Markdown document that uses reticulate to run python content
---
```{r}
library(reticulate)
```
```{python}
from pprint import pprint
xs = range(10)
pprint([(x, x**2, x**3) for x in xs])
```
rsconnect/tests/testthat/test-http.R 0000644 0001762 0000144 00000011543 14513230050 017326 0 ustar ligges users test_that("non-libCurl methods are deprecated", {
withr::local_options(rsconnect.http = "internal")
expect_snapshot(. <- httpFunction())
})
# headers -----------------------------------------------------------------
test_that("authHeaders() picks correct method based on supplied fields", {
url <- "https://example.com"
expect_equal(
authHeaders(list(), url, "GET"),
list("X-Auth-Token" = "anonymous-access")
)
expect_equal(
authHeaders(list(apiKey = "123"), url, "GET"),
list(Authorization = "Key 123")
)
local_mocked_bindings(
rfc2616Date = function() "Thu, 09 Mar 2023 14:29:00 GMT"
)
# Dummy key created with
# openssl::base64_encode(openssl::ed25519_keygen())
key <- "MC4CAQAwBQYDK2VwBCIEIDztfEgkp5CX7Jz0NCyrToaRW1L2tfmrWxNDgYyjO9bQ"
expect_snapshot({
str(authHeaders(list(secret = "123"), url, "GET"))
str(authHeaders(list(private_key = key), url, "GET"))
})
})
test_that("can add user specific headers", {
withr::local_options(rsconnect.http.headers = c(a = "1", b = "2"))
service <- httpbin_service()
json <- GET(service, list(), "get")
expect_equal(json$headers$a, "1")
expect_equal(json$headers$b, "2")
})
test_that("can add user specific cookies", {
skip_on_cran()
# uses live httpbin since webfakes doesn't support cookie endpoints
withr::local_options(rsconnect.http.cookies = c("a=1", "b=2"))
service <- parseHttpUrl("http://httpbin.org/")
skip_on_http_failure(json <- GET(service, list(), "cookies"))
expect_equal(json$cookies, list(a = "1", b = "2"))
withr::local_options(rsconnect.http.cookies = c("c=3", "d=4"))
skip_on_http_failure(POST(service, list(), "post"))
skip_on_http_failure(json <- GET(service, list(), "cookies"))
expect_equal(json$cookies, list(a = "1", b = "2", c = "3", d = "4"))
})
# handleResponse ----------------------------------------------------------
test_that("includes body in error if available", {
service <- parseHttpUrl("http://example.com/error")
service$method <- "GET"
resp_text <- list(
req = service,
status = 400,
contentType = "plain/text",
content = "Failed"
)
resp_json <- list(
req = service,
status = 400,
contentType = "application/json",
content = '{"error": "failed"}'
)
resp_html <- list(
req = service,
status = 400,
contentType = "text/html",
content = "Failed"
)
expect_snapshot(error = TRUE, {
handleResponse(resp_text)
handleResponse(resp_json)
handleResponse(resp_html)
})
})
test_that("but still gives got error if no body", {
service <- parseHttpUrl("http://example.com/error")
resp_text <- list(
req = service,
status = 400,
contentType = "plain/text",
content = ""
)
resp_json <- list(
req = service,
status = 400,
contentType = "application/json",
content = ""
)
resp_html <- list(
req = service,
status = 400,
contentType = "text/html",
content = ""
)
expect_snapshot(error = TRUE, {
handleResponse(resp_text)
handleResponse(resp_json)
handleResponse(resp_html)
})
})
test_that("errors contain method", {
service <- httpbin_service()
expect_snapshot(error = TRUE, {
GET(service, list(), path = "status/404")
POST(service, list(), path = "status/403")
}, transform = strip_port(service))
})
test_that("http error includes status in error class", {
service <- httpbin_service()
expect_error(
GET(service, list(), path = "status/404"),
class = "rsconnect_http_404"
)
expect_error(
GET(service, list(), path = "status/403"),
class = "rsconnect_http_403"
)
})
test_that("handles redirects", {
service <- httpbin_service()
out <- GET(service, list(), "absolute-redirect/3")
expect_equal(out$url, paste0(buildHttpUrl(service), "get"))
out <- GET(service, list(), "relative-redirect/3")
expect_equal(out$url, paste0(buildHttpUrl(service), "get"))
})
# parse/build -------------------------------------------------------------
test_that("URL parsing works", {
p <- parseHttpUrl("http://yahoo.com")
expect_equal(p$protocol, "http")
expect_equal(p$host, "yahoo.com")
expect_equal(p$port, "")
expect_equal(p$path, "") #TODO: bug? Should default to /?
p <- parseHttpUrl("https://rstudio.com/about")
expect_equal(p$protocol, "https")
expect_equal(p$host, "rstudio.com")
expect_equal(p$port, "")
expect_equal(p$path, "/about")
p <- parseHttpUrl("http://127.0.0.1:3939/stuff/here/?who-knows")
expect_equal(p$protocol, "http")
expect_equal(p$host, "127.0.0.1")
expect_equal(p$port, "3939")
expect_equal(p$path, "/stuff/here/?who-knows") #TODO: bug?
})
test_that("parse and build are symmetric", {
round_trip <- function(x) {
expect_equal(buildHttpUrl(parseHttpUrl(x)), x)
}
round_trip("http://google.com")
round_trip("http://google.com:80")
round_trip("https://google.com:80/a/b")
round_trip("https://google.com:80/a/b/")
})
rsconnect/tests/testthat/test-writeManifest.R 0000644 0001762 0000144 00000024171 14513230050 021171 0 ustar ligges users makeManifest <- function(appDir, appPrimaryDoc = NULL, ...) {
writeManifest(appDir, appPrimaryDoc = appPrimaryDoc, ..., quiet = TRUE)
manifestFile <- file.path(appDir, "manifest.json")
data <- readLines(manifestFile, warn = FALSE, encoding = "UTF-8")
manifestJson <- jsonlite::fromJSON(data)
unlink(manifestFile)
manifestJson
}
test_that("renv.lock is included for renv projects", {
skip_on_cran()
withr::local_options(renv.verbose = FALSE)
app_dir <- local_temp_app(list(app.R = "library(foreign); library(MASS)"))
renv::snapshot(app_dir, prompt = FALSE)
manifest <- makeManifest(app_dir)
# note: we don't see an .Rprofile here because we only renv::snapshot and
# do not fully create an renv project.
expect_named(manifest$files, c("app.R", "renv.lock"))
})
test_that("renv.lock is not included for non-renv projects", {
skip_on_cran()
withr::local_options(renv.verbose = FALSE)
app_dir <- local_temp_app(list(app.R = "library(foreign); library(MASS)"))
manifest <- makeManifest(app_dir)
expect_named(manifest$files, c("app.R"))
})
test_that("Rmd with reticulate as a dependency includes python in the manifest", {
skip_on_cran()
skip_if_not_installed("reticulate")
python <- pythonPathOrSkip()
appDir <- test_path("test-reticulate-rmds")
manifest <- makeManifest(appDir, python = python)
requirements_file <- file.path(appDir, manifest$python$package_manager$package_file)
expect_equal(requirements_file, "test-reticulate-rmds/requirements.txt")
defer(unlink(requirements_file))
expect_equal(manifest$metadata$appmode, "rmd-static")
expect_equal(manifest$metadata$primary_rmd, "index.Rmd")
expect_true(file.exists(requirements_file))
})
test_that("Rmd with reticulate as an inferred dependency includes reticulate and python in the manifest", {
skip_on_cran()
skip_if_not_installed("reticulate")
python <- pythonPathOrSkip()
appDir <- test_path("test-reticulate-rmds")
manifest <- makeManifest(appDir, "implicit.Rmd", python = python)
requirements_file <- file.path(appDir, manifest$python$package_manager$package_file)
expect_equal(requirements_file, "test-reticulate-rmds/requirements.txt")
defer(unlink(requirements_file))
expect_equal(manifest$metadata$appmode, "rmd-static")
expect_equal(manifest$metadata$primary_rmd, "implicit.Rmd")
expect_true(file.exists(requirements_file))
})
test_that("Rmd without a python block doesn't include reticulate or python in the manifest", {
skip_on_cran()
manifest <- makeManifest(test_path("test-rmds"), "simple.Rmd", python = NULL)
expect_equal(manifest$metadata$appmode, "rmd-static")
expect_equal(manifest$metadata$primary_rmd, "simple.Rmd")
expect_null(manifest$python)
})
test_that("Rmd without a python block doesn't include reticulate or python in the manifest even if python specified", {
skip_on_cran()
skip_if_not_installed("reticulate")
python <- pythonPathOrSkip()
manifest <- makeManifest("test-rmds", "simple.Rmd", python = python)
expect_equal(manifest$metadata$appmode, "rmd-static")
expect_equal(manifest$metadata$primary_rmd, "simple.Rmd")
expect_equal(manifest$python, NULL)
# Confirm that we have removed packrat entries from our file listing but
# retain entries for other files.
filenames <- names(manifest$files)
expect_false(any(grepl("^packrat/", filenames, perl = TRUE)), filenames)
expect_true(any(grepl("simple.Rmd", filenames, fixed = TRUE)), filenames)
})
# Quarto Tests
test_that("Quarto website includes quarto in the manifest", {
skip_on_cran()
skip_if_no_quarto()
appDir <- test_path("quarto-website-r")
manifest <- makeManifest(appDir, quarto = TRUE)
expect_equal(manifest$metadata$appmode, "quarto-static")
expect_equal(manifest$quarto$engines, "knitr")
expect_equal(manifest$metadata$primary_rmd, "index.qmd")
})
test_that("Quarto document includes quarto in the manifest", {
skip_on_cran()
skip_if_no_quarto()
appDir <- test_path("quarto-doc-none")
appPrimaryDoc <- "quarto-doc-none.qmd"
manifest <- makeManifest(appDir, appPrimaryDoc, quarto = TRUE)
expect_equal(manifest$metadata$appmode, "quarto-static")
expect_equal(manifest$quarto$engines, "markdown")
expect_equal(manifest$metadata$primary_rmd, "quarto-doc-none.qmd")
})
test_that("Specifying quarto arg includes quarto in the manifest, even with no appPrimaryDoc specified (.qmd)", {
skip_on_cran()
skip_if_no_quarto()
appDir <- test_path("quarto-doc-none")
appPrimaryDoc <- NULL
manifest <- makeManifest(appDir, appPrimaryDoc, quarto = TRUE)
expect_equal(manifest$metadata$appmode, "quarto-static")
expect_equal(manifest$quarto$engines, "markdown")
expect_equal(manifest$metadata$primary_rmd, "quarto-doc-none.qmd")
})
test_that("Specifying quarto arg includes quarto in the manifest, even with no appPrimaryDoc specified (.Rmd)", {
skip_on_cran()
skip_if_no_quarto()
appDir <- test_path("shiny-rmds")
appPrimaryDoc <- NULL
manifest <- makeManifest(appDir, appPrimaryDoc, quarto = TRUE)
expect_equal(manifest$metadata$appmode, "quarto-shiny")
expect_equal(manifest$quarto$engines, "knitr")
expect_equal(manifest$metadata$primary_rmd, "non-shiny-rmd.Rmd")
})
test_that("specifying quarto arg with non-quarto app does not include quarto in the manifest", {
skip_on_cran()
skip_if_no_quarto()
appDir <- test_path("shinyapp-singleR")
appPrimaryDoc <- "single.R"
manifest <- makeManifest(appDir, appPrimaryDoc, quarto = TRUE)
expect_null(manifest$quarto)
})
test_that("Quarto shiny project includes quarto in the manifest", {
skip_on_cran()
skip_if_no_quarto()
appDir <- test_path("quarto-proj-r-shiny")
manifest <- makeManifest(appDir, quarto = TRUE)
expect_equal(manifest$metadata$appmode, "quarto-shiny")
expect_equal(manifest$quarto$engines, "knitr")
expect_equal(manifest$metadata$primary_rmd, "quarto-proj-r-shiny.qmd")
})
test_that("Quarto R + Python website includes quarto and python in the manifest", {
skip_on_cran()
skip_if_not_installed("reticulate")
skip_if_no_quarto()
python <- pythonPathOrSkip()
appDir <- test_path("quarto-website-r-py")
manifest <- makeManifest(appDir, python = python, quarto = TRUE)
expect_equal(manifest$metadata$appmode, "quarto-static")
expect_equal(manifest$quarto$engines, "knitr")
expect_equal(manifest$metadata$primary_rmd, "index.qmd")
expect_true(all(c("quarto", "python") %in% names(manifest)))
expect_true("reticulate" %in% names(manifest$packages))
})
test_that("Quarto Python-only website gets correct manifest data", {
skip_on_cran()
skip_if_not_installed("reticulate")
skip_if_no_quarto()
python <- pythonPathOrSkip()
appDir <- test_path("quarto-website-py")
manifest <- makeManifest(appDir, python = python, quarto = TRUE)
expect_equal(manifest$metadata$appmode, "quarto-static")
expect_equal(manifest$quarto$engines, "jupyter")
expect_equal(manifest$metadata$primary_rmd, "index.qmd")
# We expect Quarto and Python metadata, but no R packages.
expect_true(all(c("quarto", "python") %in% names(manifest)))
expect_null(manifest$packages)
})
test_that("Deploying a Quarto project without Quarto is an error", {
skip_on_cran()
local_mocked_bindings(quarto_path = function() NULL)
appDir <- test_path("quarto-website-r")
expect_snapshot(makeManifest(appDir), error = TRUE)
})
test_that("Deploying R Markdown content with Quarto gives a Quarto app mode", {
skip_on_cran()
skip_if_no_quarto()
manifest <- makeManifest(test_path("test-rmds"), "simple.Rmd", quarto = TRUE)
expect_equal(manifest$metadata$appmode, "quarto-static")
expect_equal(manifest$quarto$engines, "knitr")
expect_equal(manifest$metadata$primary_rmd, "simple.Rmd")
})
test_that("Deploying static content with _quarto.yaml succeeds without quartoInfo", {
skip_on_cran()
manifest <- makeManifest(test_path("static-with-quarto-yaml"))
expect_equal(manifest$metadata$appmode, "static")
})
test_that("Sets environment.image in the manifest if one is provided", {
skip_on_cran()
withr::local_options(renv.verbose = TRUE)
appDir <- test_path("shinyapp-simple")
manifest <- makeManifest(appDir, image = "rstudio/content-base:latest")
expect_equal(manifest$environment$image, "rstudio/content-base:latest")
manifest <- makeManifest(appDir)
expect_null(manifest$environment)
})
test_that("Sets environment.environment_management in the manifest if envManagement is defined", {
skip_on_cran()
withr::local_options(renv.verbose = TRUE)
appDir <- test_path("shinyapp-simple")
# test shorthand arg
manifest <- makeManifest(appDir, envManagement = FALSE, envManagementR = TRUE, envManagementPy = TRUE)
expect_equal(manifest$environment$environment_management$r, FALSE)
expect_equal(manifest$environment$environment_management$python, FALSE)
# test R and Python args
manifest <- makeManifest(appDir, envManagementR = TRUE)
expect_equal(manifest$environment$environment_management$r, TRUE)
expect_null(manifest$environment$environment_management$python)
manifest <- makeManifest(appDir, envManagementPy = TRUE)
expect_equal(manifest$environment$environment_management$python, TRUE)
expect_null(manifest$environment$environment_management$r)
# environment_management is not defined when envManagementR and envManagementPy are NULL
manifest <- makeManifest(appDir, image = "rstudio/content-base:latest")
expect_null(manifest$environment$environment_management)
})
# appMode Inference tests
test_that("content type (appMode) is inferred and can be overridden", {
skip_on_cran()
appDir <- local_temp_app(list(
"app.R" = "",
"index.html" = "",
"plumber.R" = "",
"report.Rmd" = ""
))
files <- c("app.R", "index.html", "plumber.R", "report.Rmd")
manifest <- makeManifest(appDir)
expect_equal(manifest$metadata$appmode, "api")
expect_named(manifest$files, files)
manifest <- makeManifest(appDir, appMode = "shiny")
expect_equal(manifest$metadata$appmode, "shiny")
expect_named(manifest$files, files)
manifest <- makeManifest(appDir, appMode = "rmd-static")
expect_equal(manifest$metadata$appmode, "rmd-static")
expect_named(manifest$files, files)
manifest <- makeManifest(appDir, appMode = "static")
expect_equal(manifest$metadata$appmode, "static")
expect_named(manifest$files, files)
})
rsconnect/tests/manual/ 0000755 0001762 0000144 00000000000 14513230050 014660 5 ustar ligges users rsconnect/tests/manual/appMode.Rmd 0000644 0001762 0000144 00000004577 14513230050 016726 0 ustar ligges users # appMode overrides
These test deploying one project to multiple targets having different types,
confirming `deployApp()` support for its `appMode`.
1. Create a new project.
```r
usethis::create_project("~/Desktop/appmode-lies")
```
2. Populate that project with content.
```r
writeLines(c(
"shinyApp(ui = fluidPage('Shiny lying liars lie.'), server = function(input, output){})"
), "app.R")
writeLines(c(
"",
"appmode lies",
"",
"
Static lying liars lie.
",
"app.R,",
"plumber.R,",
"report.Rmd",
"",
""
), "index.html")
writeLines(c(
"---",
"title: Reporting lying liars lie.",
"---",
"",
"Reporting lying liars lie."
), "report.Rmd")
writeLines(c(
"#* @get /lie",
"function() { 'API lying liars lie.' }"
), "plumber.R")
3. Deploy this content in a variety of ways.
```r
account <- ""
server <- ""
rsconnect::deployApp(
appTitle = "lying: inference",
appFiles = c("app.R", "index.html", "plumber.R", "report.Rmd"),
account = account,
server = server
)
rsconnect::deployApp(
appName = "appmode-lies-plumber",
appTitle = "lying: plumber",
appFiles = c("app.R", "index.html", "plumber.R", "report.Rmd"),
appMode = "api",
account = account,
server = server
)
rsconnect::deployApp(
appName = "appmode-lies-shiny",
appTitle = "lying: shiny",
appFiles = c("app.R", "index.html", "plumber.R", "report.Rmd"),
appMode = "shiny",
account = account,
server = server
)
rsconnect::deployApp(
appName = "appmode-lies-rmarkdown",
appTitle = "lying: rmarkdown",
appFiles = c("app.R", "index.html", "plumber.R", "report.Rmd"),
appMode = "rmd-static",
account = account,
server = server
)
rsconnect::deployApp(
appName = "appmode-lies-static",
appTitle = "lying: static",
appFiles = c("app.R", "index.html", "plumber.R", "report.Rmd"),
appMode = "static",
account = account,
server = server
)
```
rsconnect/tests/manual/dependencies.Rmd 0000644 0001762 0000144 00000003606 14513230050 017757 0 ustar ligges users # renv snapshots
These test the full end-to-end publishing experience with renv.
## Archived package
1. Create a new project.
```r
usethis::create_project("~/desktop/rsconnect-archived")
```
The remaining steps happen within this newly created project.
2. Install an old version of `rowr`.
```r
devtools::install_version('rowr', '1.1.3')
```
3. Run the following code to create an `app.R`:
```r
writeLines(c(
"library(rowr)",
"shinyApp(ui = fluidPage('shiny rowr'), server = function(input, output){})"
), "app.R")
```
4. Deploy to shinyapps.io:
```r
rsconnect::deployApp(server = "shinyapps.io")
```
5. Deploy to colorado (Posit employees, only):
```r
rsconnect::deployApp(server = "colorado.posit.co")
```
Expected behaviour:
- App successfully deploys to shinyapps.
- App successfully deploys to colorado.
## CRAN, github, and BioC packages
1. Create a new project:
```r
usethis::create_project("~/desktop/rsconnect-key-types")
````
The remaining steps happen within this newly created project.
2. Install CRAN, GitHub, and Bioconductor packages into your library:
```r
pak::pak(c("rlang", "r-lib/waldo", "bioc::Biobase"))
```
3. Run the following code to create an `app.R`:
```r
writeLines(c(
"library(rlang)",
"library(waldo)",
"library(Biobase)",
"shinyApp(ui = fluidPage('shiny rowr'), server = function(input, output){})"
), "app.R")
```
4. Deploy this app (analyzing your library):
```r
rsconnect::deployApp()
```
5. Create an renv snapshot:
```r
renv::snapshot()
```
6. Deploy this app (using the `renv.lock`):
```r
rsconnect::deployApp()
```
Expected behaviour:
- App deploys without error when analyzing your R library.
- App deploys without error when analyzing the `renv.lock`.
rsconnect/tests/manual/publishing-dialog.Rmd 0000644 0001762 0000144 00000003752 14513230050 020734 0 ustar ligges users # Connections
## Remove an account
1. Open Options | Publishing.
1. Select `colorado.posit.co` then click disconnect.
Success:
* No errors dialogs or error messages in console.
* `nrow(rsconnect::accounts("colorado.posit.co"))` returns 0.
## Add a Connect account
1. Open Options | Publishing.
1. Click Connect, then "Posit Connect".
1. Paste in `https://colorado.posit.co/rsc` and click next.
1. Login connect in browser window, then click next.
Success:
* Dialog shows "Account Verified".
* No errors dialogs or error messages in console.
* `nrow(rsconnect::accounts("colorado.posit.co"))` returns 1.
### Add a shiny account
1. Open Options | Publishing.
1. Click Connect, then Shinyapps.io.
1. Follow the on-screen instuctions, then click Connect Account.
Success:
1. No errors in console
1. `nrow(rsconnect::accounts("shinyapps.io"))` returns 1 or greater.
# Apps
1. Create a new shiny app by clicking "New Project" | "New Directory" | "Shiny app"
### Deploy an app for the first time
1. Click the deploy button then select "colarado.posit.co"
Success:
1. Deploy tab opens, and eventually deploy completes, and opens in connect.
### Re-deploy an app
1. Click the deploy button then click "Publish"
Success:
1. Existing colorado deployment should appear in publish dialog
1. Deploy tab opens, and eventually deploy completes, and opens in connect.
### Re-deploy an with missing metadata
1. Run `unlink("rsconnect", recursive = TRUE)`
1. Click the deploy button then click "Publish".
Success:
1. Dialog asks if you want to replace existing content.
1. After clicking "Replace" the deploy succeeds.
### Re-deploy to deleted app
1. On deployed app click "..." menu, then delete.
1. Click ok, wait 30s, then refresh the page to confirm the app is deleted.
1. Return to RStudio, then click the deploy drop down. Choose other destinations, then click deploy.
Success:
1. Deploy tab opens, and eventually deploy completes, and opens in connect.
Finish up by deleting the app you just deployed.
rsconnect/tests/manual/deploySite.Rmd 0000644 0001762 0000144 00000007272 14513230050 017455 0 ustar ligges users # Sites
## Quarto
### Quarto using R (no additional dependencies)
1. Clone
1. Open the RStudio project `bundles/quarto-website-r`.
1. When opened, you may see a message indicating that the project library
and lockfile are out of sync. If so, restore its environment:
```r
renv::restore()
```
1. Update rsconnect and renv within this project; as the lockfile probably
references different versions than what you want to test:
```r
install.packages(c("renv","rsconnect"))
```
1. Deploy, then re-deploy. If this is the first time deploying from this
directory, you will be prompted for a deployment target. The re-deploy
should NEVER prompt.
```r
# initial deploy: renders, then publishes.
rsconnect::deploySite(render = "local")
# re-deply: renders, then publishes.
rsconnect::deploySite(render = "local")
# re-deploy: NO RENDER, only publishes.
rsconnect::deploySite(render = "none")
```
The content successfully deploys as static (HTML) that was rendered on the
client.
1. Deploy having the content render on the server. If this is the first time
deploying with this title, you will be prompted for a deployment target.
```r
# initial deploy: publishes on the server.
rsconnect::deploySite(siteName = "quarto-website-r-renders", render = "server")
```
The content successfully deploys as Quarto to be rendered by Connect.
### Quarto using R (having additional dependencies)
1. Clone
1. Open the RStudio project `bundles/quarto-website-r-deps`.
1. When opened, you may see a message indicating that the project library
and lockfile are out of sync. If so, restore its environment:
```r
renv::restore()
```
1. Update rsconnect and renv within this project; as the lockfile probably
references different versions than what you want to test:
```r
install.packages(c("renv","rsconnect"))
```
1. Deploy this content. Rendering happens on the server. If this is the first time
deploying with this title, you will be prompted for a deployment target.
```r
rsconnect::deploySite(render = "server")
```
The content successfully deploys as Quarto to be rendered by Connect.
## RMarkdown
1. Clone
1. Open the RStudio project `bundles/rmd-site`.
1. When opened, you may see a message indicating that the project library
and lockfile are out of sync. If so, restore its environment:
```r
renv::restore()
```
1. Update rsconnect and renv within this project; as the lockfile probably
references different versions than what you want to test:
```r
install.packages(c("renv","rsconnect"))
```
1. Deploy, then re-deploy. If this is the first time deploying from this
directory, you will be prompted for a deployment target. The re-deploy
should NEVER prompt.
```r
# initial deploy: renders, then publishes.
rsconnect::deploySite(render = "local")
# re-deply: renders, then publishes.
rsconnect::deploySite(render = "local")
# re-deploy: NO RENDER, only publishes.
rsconnect::deploySite(render = "none")
```
The content successfully deploys as static (HTML) that was rendered on the
client.
1. Deploy having the content render on the server. If this is the first time
deploying with this title, you will be prompted for a deployment target.
```r
# initial deploy: publishes on the server.
rsconnect::deploySite(siteName = "rmd-site-renders", render = "server")
```
The content successfully deploys as R Markdown to be rendered by Connect.
rsconnect/tests/testthat.R 0000644 0001762 0000144 00000000076 14513230050 015371 0 ustar ligges users library(testthat)
library(rsconnect)
test_check("rsconnect")
rsconnect/vignettes/ 0000755 0001762 0000144 00000000000 14536677712 014302 5 ustar ligges users rsconnect/vignettes/custom-http.Rmd 0000644 0001762 0000144 00000006117 14513230050 017211 0 ustar ligges users ---
title: "Customising HTTP requests"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Customising HTTP requests}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
```
```{r setup}
library(rsconnect)
```
Depending on the configuration of your environment, you may need to cutomize the way that rsconnect sends http requests. Typically, this is required for some special
## `.rsconnect_profile`
When deploying content from the RStudio IDE, the rsconnect package's deployment methods are executed in a vanilla R session that doesn't execute startup scripts. This can make it challenging to ensure options are set properly prior to push-button deployment, so the rsconnect package has a parallel set of "startup" scripts it runs prior to deploying.
The following are run in order, if they exist, prior to deployment:
* `$R_HOME/etc/rsconnect.site`: Like `Rprofile.site` for site-wide pre-flight and options.
This is typically used by system administrators.
* `~/.rsconnect_profile`, like `.Rprofile`; this will affect all apps that you deploy.
* `.rsconnect_profile`, like `.Rprofile`; this will affect the current app.
Unlike `.Rprofile`, if `~/.rsconnect_profile`, is present, it will also be run.
## HTTP Proxy Environment Variable
The most straightforward way to specify a proxy is to set the `HTTPS_PROXY` environment variable. For example, you could add the following code to your `.rsconnect_profile`:
```R
Sys.setenv(https_proxy = "https://proxy.example.com")
```
Proxy settings can include a host-name, port, and username/password if necessary. The following
are all valid values for the `http_proxy` environment variable:
* `http://proxy.example.com/`
* `http://proxy.example.com:1080/`
* `http://username:password@proxy.example.com:1080/`
## Custom headers and cookies
If you need to supply additional headers or cookies, you can use the options `rsconnect.http.headers` and `rsconnect.http.cookies` respectively. `rsconnect.http.headers` needs a named vector of header names and values:
```{r}
options(
rsconnect.http.headers = c(
"CustomHeader1" = "CustomValue", "CustomHeader2" = "CustomValue2"
)
)
```
While `rsconnect.http.cookies` expects cookies formatted the same way that a webserver expects them:
```{r}
options(
rsconnect.http.headers = c("cookie1=value1", "cookie2=value2")
)
```
And you can supply other cookie parameters if needed:
```{r}
options(
rsconnect.http.headers = "cookie1=value1; Expires=Thu, 31 Oct 2021 07:28:00 GMT; Secure"
)
```
The custom headers are set first, so will be overridden by the headers that rsconnect needs to correctly operate. Similarly, cookies will be set prior to the first request, and will be overriden by anything returned by the server.
## Other custom options
Finally, you can supply any additional options supported by `curl::curl_options()` with `rsconnect.libcurl.options`, e.g.
```R
options(rsconnect.libcurl.options = list(proxy = "http://proxy.example.com")
```
Run `curl::curl_options()` to see a list of options.
rsconnect/R/ 0000755 0001762 0000144 00000000000 14536677712 012473 5 ustar ligges users rsconnect/R/configMigrate.R 0000644 0001762 0000144 00000007256 14513230050 015355 0 ustar ligges users # account/server ----------------------------------------------------------
migrateConfig <- function(configDir) {
# For historical reasons too painful to enumerate here, there are not one
# but *two* old locations for configuration files to check. If we find
# one, we need to move its contents to the new folder.
oldConfigDir <- oldApplicationConfigDir("rsconnect")
if (!dirExists(oldConfigDir)) {
oldConfigDir <- oldApplicationConfigDir("connect")
}
# We have no configuration directory but we do have an old one; migrate it.
if (dirExists(oldConfigDir)) {
# Create the parent folder if necessary
dirCreate(dirname(configDir))
# Migrate the old directory to the new one
file.rename(oldConfigDir, configDir)
}
}
#' Old Application Config Directory
#'
#' Returns the old application configuration directory used by rsconnect
#' 0.8.24 and prior. These versions wrote configuration data to XDG compliant
#' locations, but CRAN policy has since further restricted the disk locations
#' that are permitted. See:
#'
#' https://cran.r-project.org/web/packages/policies.html
#'
#' @param appName The application's name (connect or rsconnect)
#'
#' @return The old application configuration directory.
#'
#' @keywords internal
oldApplicationConfigDir <- function(appName) {
# get the home directory from the operating system (in case
# the user has redefined the meaning of ~) but fault back
# to ~ if there is no HOME variable defined
homeDir <- Sys.getenv("HOME", unset = "~")
# check for R specific config dir
configDir <- Sys.getenv("R_USER_CONFIG_DIR")
if (nzchar(configDir)) {
# R specific config dir, append app name only
configDir <- file.path(configDir, appName)
} else {
# no R specific config dir; determine application config dir (platform specific)
sysName <- Sys.info()[["sysname"]]
if (identical(sysName, "Windows"))
configDir <- Sys.getenv("APPDATA")
else if (identical(sysName, "Darwin"))
configDir <- file.path(homeDir, "Library/Application Support")
else
configDir <- Sys.getenv("XDG_CONFIG_HOME", file.path(homeDir, ".config"))
# append the application name
configDir <- file.path(configDir, "R", appName)
}
# normalize path
normalizePath(configDir)
}
# deployments -------------------------------------------------------------
migrateDeploymentsConfig <- function(appPath) {
# calculate migration dir--all shinyapps deployment records go into the root
# folder since it wasn't possible to deploy individual docs using the
# shinyapps package
migrateRoot <- if (isDocumentPath(appPath)) dirname(appPath) else appPath
# migrate shinyapps package created records if necessary
shinyappsDir <- file.path(migrateRoot, "shinyapps")
if (!file.exists(shinyappsDir)) {
return()
}
migrateDir <- file.path(migrateRoot, "rsconnect")
for (shinyappsFile in list.files(shinyappsDir, glob2rx("*.dcf"),
recursive = TRUE)) {
# read deployment record
shinyappsDCF <- file.path(shinyappsDir, shinyappsFile)
deployment <- as.data.frame(read.dcf(shinyappsDCF),
stringsAsFactors = FALSE)
deployment$server <- "shinyapps.io"
# write the new record
rsconnectDCF <- file.path(migrateDir, "shinyapps.io", shinyappsFile)
dirCreate(dirname(rsconnectDCF))
write.dcf(deployment, rsconnectDCF)
# remove old DCF
file.remove(shinyappsDCF)
}
# remove shinyapps dir if it's completely empty
remainingFiles <- list.files(shinyappsDir,
recursive = TRUE,
all.files = TRUE)
if (length(remainingFiles) == 0)
unlink(shinyappsDir, recursive = TRUE)
}
rsconnect/R/cookies.R 0000644 0001762 0000144 00000015313 14513230050 014224 0 ustar ligges users
# Environment in which cookies will be stored. Cookies are expected to survive
# the duration of the R session, but are not persisted outside of the R
# session.
.cookieStore <- new.env(parent = emptyenv())
# Returns the cookies associated with a particular host/port
# If no hostname is specified, returns all cookies
getCookies <- function(hostname, port = NULL) {
if (missing(hostname)) {
hosts <- ls(envir = .cookieStore)
cookies <- lapply(hosts, function(h) {
getCookiesHostname(h)
})
do.call("rbind", cookies)
} else {
host <- getCookieHost(list(host = hostname, port = port))
getCookiesHostname(host)
}
}
# Get cookies for a particular hostname(:port)
getCookiesHostname <- function(host) {
if (!exists(host, .cookieStore)) {
NULL
} else {
cookies <- get(host, envir = .cookieStore)
cookies$host <- host
cookies
}
}
# Clears the cookies associated with a particular hostname/port combination.
# If hostname and port are omitted, clears all the cookies
clearCookies <- function(hostname, port = NULL) {
if (missing(hostname)) {
rm(list = ls(envir = .cookieStore), envir = .cookieStore)
} else {
host <- getCookieHost(list(host = hostname, port = port))
rm(list = host, envir = .cookieStore)
}
}
# Parse out the raw headers provided and insert them into the cookieStore
# NOTE: Domain attribute is currently ignored
# @param requestURL the parsed URL as returned from `parseHttpUrl`
# @param cookieHeaders a list of characters strings representing the raw
# Set-Cookie header value with the "Set-Cookie: " prefix omitted
storeCookies <- function(requestURL, cookieHeaders) {
cookies <- lapply(cookieHeaders, parseCookie, requestPath = requestURL$path)
# Filter out invalid cookies (which would return as NULL)
cookies <- Filter(Negate(is.null), cookies)
host <- getCookieHost(requestURL)
hostCookies <- NULL
if (!exists(host, .cookieStore)) {
# Create a new data frame for this host
hostCookies <- data.frame(
path = character(0),
name = character(0),
value = character(0),
secure = logical(0),
expires = character(0),
stringsAsFactors = FALSE
)
} else {
hostCookies <- get(host, envir = .cookieStore)
}
lapply(cookies, function(co) {
# Remove any duplicates
# RFC says duplicate cookies are ones that have the same domain, name, and path
hostCookies <<- hostCookies[!(co$name == hostCookies$name & co$path == hostCookies$path), ]
# append this new cookie on
hostCookies <<- rbind(as.data.frame(co, stringsAsFactors = FALSE), hostCookies)
})
# Save this host's cookies into the cookies store.
assign(host, hostCookies, envir = .cookieStore)
}
# Parse out an individual cookie
# @param cookieHeader the raw text contents of the Set-Cookie header with the
# header name omitted.
# @param requestPath the parsed URL as returned from `parseHttpUrl`
parseCookie <- function(cookieHeader, requestPath = NULL) {
keyval <- regmatches(cookieHeader, regexec(
# https://curl.haxx.se/rfc/cookie_spec.html
# "characters excluding semi-colon, comma and white space"
# white space is not excluded from values so we can capture `expires`
"^([^;=, ]+)\\s*=\\s*([^;,]*)(;|$)", cookieHeader, ignore.case = TRUE))[[1]]
if (length(keyval) == 0) {
# Invalid cookie format.
warning("Unable to parse set-cookie header: ", cookieHeader)
return(NULL)
}
key <- keyval[2]
val <- keyval[3]
# Path
path <- regmatches(cookieHeader, regexec(
"^.*\\sPath\\s*=\\s*([^;]+)(;|$).*$", cookieHeader, ignore.case = TRUE))[[1]]
if (length(path) == 0) {
path <- "/"
} else {
path <- path[2]
}
# Per the RFC, the cookie's path must be a prefix of the request URL
if (!is.null(requestPath) && !hasPrefix(requestPath, path)) {
warning("Invalid path set for cookie on request for '", requestPath, "': ", cookieHeader)
return(NULL)
}
# MaxAge
maxage <- regmatches(cookieHeader, regexec(
"^.*\\sMax-Age\\s*=\\s*(-?\\d+)(;|$).*$", cookieHeader, ignore.case = TRUE))[[1]]
# If no maxage specified, then this is a session cookie, which means that
# (since our cookies only survive for a single session anyways...) we should
# keep this cookie around as long as we're alive.
expires <- Sys.time() + 10^10
if (length(maxage) > 0) {
# Compute time maxage seconds from now
expires <- Sys.time() + as.numeric(maxage[2])
}
# Secure
secure <- grepl(";\\s+Secure(;|$)", cookieHeader, ignore.case = TRUE)
list(name = key,
value = val,
expires = expires,
path = path,
secure = secure)
}
# Appends a cookie header from the .cookieStore to the existing set of headers
# @param requestURL the parsed URL as returned from `parseHttpUrl`
# @param headers a named character vector containing the set of headers to be extended
appendCookieHeaders <- function(requestURL, headers) {
host <- getCookieHost(requestURL)
if (!exists(host, .cookieStore)) {
# Nothing to do
return(headers)
}
cookies <- get(host, envir = .cookieStore)
# If any cookies are expired, remove them from the cookie store
if (any(cookies$expires < as.integer(Sys.time()))) {
cookies <- cookies[cookies$expires >= as.integer(Sys.time()), ]
# Update the store, removing the expired cookies
assign(host, cookies, envir = .cookieStore)
}
if (nrow(cookies) == 0) {
# Short-circuit, return unmodified headers.
return(headers)
}
# Filter to only include cookies that match the path prefix
cookies <- cookies[substring(requestURL$path, 1, nchar(cookies$path)) == cookies$path, ]
# If insecure channel, filter out secure cookies
if (tolower(requestURL$protocol) != "https") {
cookies <- cookies[!cookies$secure, ]
}
# TODO: Technically per the RFC we're supposed to order these cookies by which
# paths most specifically match the request.
cookieHeader <- paste(
apply(cookies, 1, function(x) paste0(x["name"], "=", x["value"])),
collapse = "; "
)
c(headers, cookie = cookieHeader)
}
getCookieHost <- function(requestURL) {
host <- requestURL$host
port <- requestURL$port
if (!is.null(port) && nchar(port) > 0) {
port <- sub("^:", "", port)
# By my reading of the RFC, we technically only need to include the port #
# in the index if the host is an IP address. But here we're including the
# port number as a part of the host whether using a domain name or IP.
# Erring on the side of not sending the cookies to the wrong services
host <- paste(host, port, sep = ":")
}
host
}
showCookies <- function(urlstr) {
url <- parseHttpUrl(urlstr)
cat("Cookies:", "\n")
host <- getCookieHost(url)
if (exists(host, .cookieStore)) {
print(get(host, envir = .cookieStore))
} else {
print("None")
}
}
rsconnect/R/accounts.R 0000644 0001762 0000144 00000025312 14536333553 014430 0 ustar ligges users #' Account Management Functions
#'
#' Functions to enumerate and remove accounts on the local system. Prior to
#' deploying applications you need to register your account on the local system.
#'
#' You register an account using the [setAccountInfo()] function (for
#' ShinyApps) or [connectUser()] function (for other servers). You can
#' subsequently remove the account using the `removeAccount` function.
#'
#' The `accounts` and `accountInfo` functions are provided for viewing
#' previously registered accounts.
#'
#' @param name Name of account
#' @param server Name of the server on which the account is registered
#' (optional; see [servers()])
#'
#' @return `accounts` returns a data frame with the names of all accounts
#' registered on the system and the servers on which they reside.
#' `accountInfo` returns a list with account details.
#'
#' @rdname accounts
#' @export
accounts <- function(server = NULL) {
configPaths <- accountConfigFiles(server)
names <- file_path_sans_ext(basename(configPaths))
servers <- basename(dirname(configPaths))
servers[servers == "."] <- "shinyapps.io"
data.frame(name = names, server = servers, stringsAsFactors = FALSE)
}
#' Register account on Posit Connect
#
#' @description
#' `connectUser()` and `connectApiUser()` connect your Posit Connect account to
#' the rsconnect package so that it can deploy and manage applications on
#' your behalf.
#'
#' `connectUser()` is the easiest place to start because it allows you to
#' authenticate in-browser to your Posit Connect server. `connectApiUser()` is
#' appropriate for non-interactive settings; you'll need to copy-and-paste the
#' API key from your account settings.
#'
#' @param account A name for the account to connect.
#' @param server The server to connect to.
#' @param launch.browser If true, the system's default web browser will be
#' launched automatically after the app is started. Defaults to `TRUE` in
#' interactive sessions only. If a function is passed, it will be called
#' after the app is started, with the app URL as a parameter.
#' @param apiKey The API key used to authenticate the user
#' @param quiet Whether or not to show messages and prompts while connecting the
#' account.
#' @family Account functions
#' @export
connectApiUser <- function(account = NULL, server = NULL, apiKey, quiet = FALSE) {
server <- findServer(server)
user <- getAuthedUser(server, apiKey = apiKey)
registerAccount(
serverName = server,
accountName = account %||% user$username,
accountId = user$id,
apiKey = apiKey
)
if (!quiet) {
accountLabel <- accountLabel(user$username, server)
cli::cli_alert_success("Registered account for {accountLabel}")
}
invisible()
}
#' @rdname connectApiUser
#' @export
connectUser <- function(account = NULL,
server = NULL,
quiet = FALSE,
launch.browser = getOption("rsconnect.launch.browser", interactive())) {
server <- findServer(server)
resp <- getAuthTokenAndUser(server, launch.browser)
registerAccount(
serverName = server,
accountName = account %||% resp$user$username,
accountId = resp$user$id,
token = resp$token$token,
private_key = resp$token$private_key
)
if (!quiet) {
accountLabel <- accountLabel(resp$user$username, server)
cli::cli_alert_success("Registered account for {accountLabel}")
}
invisible()
}
getAuthTokenAndUser <- function(server, launch.browser = TRUE) {
token <- getAuthToken(server)
if (isTRUE(launch.browser))
utils::browseURL(token$claim_url)
else if (is.function(launch.browser))
launch.browser(token$claim_url)
if (isFALSE(launch.browser)) {
cli::cli_alert_warning("Open {.url {token$claim_url}} to authenticate")
} else {
cli::cli_alert_info("A browser window should open to complete authentication")
cli::cli_alert_warning("If it doesn't open, please go to {.url {token$claim_url}}")
}
user <- waitForAuthedUser(
server,
token = token$token,
private_key = token$private_key
)
list(
token = token,
user = user
)
}
# Used by the IDE
getAuthToken <- function(server, userId = 0) {
token <- generateToken()
# Send public key to server, and generate URL where the token can be claimed
account <- list(server = server)
client <- clientForAccount(account)
response <- client$addToken(list(
token = token$token,
public_key = token$public_key,
user_id = 0L
))
list(
token = token$token,
private_key = secret(token$private_key),
claim_url = response$token_claim_url
)
}
# generateToken generates a token for signing requests sent to the Posit
# Connect service. The token's ID and public key are sent to the server, and
# the private key is saved locally.
generateToken <- function() {
key <- openssl::rsa_keygen(2048L)
priv.der <- openssl::write_der(key)
pub.der <- openssl::write_der(key$pubkey)
tokenId <- paste(c("T", openssl::rand_bytes(16)), collapse = "")
list(
token = tokenId,
public_key = openssl::base64_encode(pub.der),
private_key = openssl::base64_encode(priv.der)
)
}
waitForAuthedUser <- function(server,
token = NULL,
private_key = NULL,
apiKey = NULL) {
# keep trying to authenticate until we're successful; server returns
# 500 "Token is unclaimed error" while waiting for interactive auth to complete
cli::cli_progress_bar(format = "{cli::pb_spin} Waiting for authentication...")
repeat {
for (i in 1:10) {
Sys.sleep(0.1)
cli::cli_progress_update()
}
user <- tryCatch(
getAuthedUser(
server,
token = token,
private_key = private_key,
apiKey = apiKey
),
rsconnect_http_500 = function(err) NULL
)
if (!is.null(user)) {
cli::cli_progress_done()
break
}
}
user
}
getAuthedUser <- function(server,
token = NULL,
private_key = NULL,
apiKey = NULL) {
if (!xor(is.null(token) && is.null(private_key), is.null(apiKey))) {
cli::cli_abort("Must supply either {.arg token} + {private_key} or {.arg apiKey}")
}
account <- list(
server = server,
apiKey = apiKey,
token = token,
private_key = private_key
)
client <- clientForAccount(account)
client$currentUser()
}
#' Register account on shinyapps.io or posit.cloud
#'
#' Configure a ShinyApps or Posit Cloud account for publishing from this system.
#'
#' @param name Name of account to save or remove
#' @param token User token for the account
#' @param secret User secret for the account
#' @param server Server to associate account with.
#'
#' @examples
#' \dontrun{
#'
#' # register an account
#' setAccountInfo("user", "token", "secret")
#'
#' # remove the same account
#' removeAccount("user")
#' }
#'
#' @family Account functions
#' @export
setAccountInfo <- function(name, token, secret, server = "shinyapps.io") {
check_string(name)
check_string(token)
check_string(secret)
check_string(server)
accountId <- findShinyAppsAccountId(name, token, secret, server)
registerAccount(
serverName = server,
accountName = name,
accountId = accountId,
token = token,
secret = secret
)
invisible()
}
# A user can have multiple accounts, so iterate over all accounts looking
# for one with the specified name
findShinyAppsAccountId <- function(name,
token,
secret,
server,
error_call = caller_env()) {
if (secret == "") {
cli::cli_abort(
c(
"You've copied and pasted the wrong thing.",
i = "Either click 'Show secret' or 'Copy to clipboard'."
),
call = error_call
)
}
account <- list(token = token, secret = secret, server = server)
client <- clientForAccount(account)
userId <- client$currentUser()$id
accountId <- NULL
accounts <- client$accountsForUser(userId)
for (account in accounts) {
if (identical(account$name, name)) {
return(account$id)
}
}
cli::cli_abort("Unable to determine {.arg accountId} for account {.str {name}}")
}
#' @rdname accounts
#' @family Account functions
#' @export
accountInfo <- function(name = NULL, server = NULL) {
findAccountInfo(name, server)
}
# Discovers then loads details about an account from disk.
# Internal equivalent to accountInfo that lets callers provide error context.
findAccountInfo <- function(name = NULL, server = NULL, error_call = caller_env()) {
fullAccount <- findAccount(name, server, error_call = error_call)
configFile <- accountConfigFile(fullAccount$name, fullAccount$server)
accountDcf <- read.dcf(configFile, all = TRUE)
info <- as.list(accountDcf)
# Account records previously had username, now have name. Internal callers expect "name", but
# external callers may expect "username". (#1024)
info$name <- info$name %||% info$username
info$username <- info$name
# remove all whitespace from private key
if (!is.null(info$private_key)) {
info$private_key <- gsub("[[:space:]]", "", info$private_key)
}
# Hide credentials
info$private_key <- secret(info$private_key)
info$secret <- secret(info$secret)
info$apiKey <- secret(info$apiKey)
info
}
hasAccount <- function(name, server) {
file.exists(accountConfigFile(name, server))
}
#' @rdname accounts
#' @export
removeAccount <- function(name = NULL, server = NULL) {
fullAccount <- findAccount(name, server)
configFile <- accountConfigFile(fullAccount$name, fullAccount$server)
file.remove(configFile)
invisible(NULL)
}
registerAccount <- function(serverName,
accountName,
accountId,
token = NULL,
secret = NULL,
private_key = NULL,
apiKey = NULL) {
check_string(serverName)
check_string(accountName)
if (!is.null(secret)) {
secret <- as.character(secret)
}
fields <- list(
name = accountName,
server = serverName,
accountId = accountId,
token = token,
secret = secret,
private_key = private_key,
apiKey = apiKey
)
path <- accountConfigFile(accountName, serverName)
dir.create(dirname(path), recursive = TRUE, showWarnings = FALSE)
write.dcf(compact(fields), path, width = 100)
# set restrictive permissions on it if possible
if (identical(.Platform$OS.type, "unix"))
Sys.chmod(path, mode = "0600")
path
}
accountLabel <- function(account, server) {
# Note: The incoming "account" may correspond to our local account name, which does not always
# match the remote username.
paste0("server: ", server, " / username: ", account)
}
rsconnect/R/http.R 0000644 0001762 0000144 00000041027 14513230050 013550 0 ustar ligges users
#' @param authInfo Typically an object created by `accountInfo()` augmented
#' with the `certificate` from the corresponding `serverInfo()`.
#'
#' There are three different fields used for auth:
#' * `secret`: set in `setAccountInfo()`
#' * `private_key`: set in `connectUser()`
#' * `apiKey`: set in `connectApiUser()`
#'
#' @noRd
httpRequest <- function(service,
authInfo,
method,
path,
query,
headers = list(),
timeout = NULL,
error_call = caller_env()) {
storeCookies(service, httpCookies())
path <- buildPath(service$path, path, query)
headers <- c(headers, authHeaders(authInfo, method, path), httpHeaders())
certificate <- requestCertificate(service$protocol, authInfo$certificate)
# perform request
http <- httpFunction()
httpResponse <- http(
protocol = service$protocol,
host = service$host,
port = service$port,
method = method,
path = path,
headers = headers,
timeout = timeout,
certificate = certificate
)
while (isRedirect(httpResponse$status)) {
service <- redirectService(service, httpResponse$location)
httpResponse <- http(
protocol = service$protocol,
host = service$host,
port = service$port,
method = method,
path = service$path,
headers = headers,
timeout = timeout,
certificate = certificate
)
}
handleResponse(httpResponse, error_call = error_call)
}
httpRequestWithBody <- function(service,
authInfo,
method,
path,
query = NULL,
contentType = NULL,
file = NULL,
content = NULL,
headers = list(),
error_call = caller_env()) {
if ((is.null(file) && is.null(content))) {
stop("You must specify either the file or content parameter.")
}
if ((!is.null(file) && !is.null(content))) {
stop("You must specify either the file or content parameter but not both.")
}
# if we have content then write it to a temp file before posting
if (!is.null(content)) {
file <- tempfile()
writeChar(content, file, eos = NULL, useBytes = TRUE)
}
storeCookies(service, httpCookies())
path <- buildPath(service$path, path, query)
headers <- c(headers, httpHeaders())
authed_headers <- c(headers, authHeaders(authInfo, method, path, file))
certificate <- requestCertificate(service$protocol, authInfo$certificate)
# perform request
http <- httpFunction()
httpResponse <- http(
protocol = service$protocol,
host = service$host,
port = service$port,
method = method,
path = path,
headers = authed_headers,
contentType = contentType,
contentFile = file,
certificate = certificate
)
while (isRedirect(httpResponse$status)) {
# This is a simplification of the spec, since we should preserve
# the method for 307 and 308, but that's unlikely to arise for our apps
# https://www.rfc-editor.org/rfc/rfc9110.html#name-redirection-3xx
service <- redirectService(service, httpResponse$location)
authed_headers <- c(headers, authHeaders(authInfo, "GET", service$path))
httpResponse <- http(
protocol = service$protocol,
host = service$host,
port = service$port,
method = "GET",
path = service$path,
headers = authed_headers,
certificate = certificate
)
httpResponse
}
handleResponse(httpResponse, error_call = error_call)
}
isRedirect <- function(status) {
status %in% c(301, 302, 307, 308)
}
redirectService <- function(service, location) {
if (grepl("^/", location)) {
service$path <- location
service
} else {
parseHttpUrl(location)
}
}
handleResponse <- function(response, error_call = caller_env()) {
url <- buildHttpUrl(response$req)
reportError <- function(msg) {
cli::cli_abort(
c("<{url}> failed with HTTP status {response$status}", msg),
class = c(paste0("rsconnect_http_", response$status), "rsconnect_http"),
call = error_call
)
}
if (isContentType(response$contentType, "application/json")) {
# parse json responses
if (nzchar(response$content)) {
json <- jsonlite::fromJSON(response$content, simplifyVector = FALSE)
} else {
json <- list()
}
if (response$status %in% 200:399) {
out <- json
} else if (!is.null(json$error)) {
reportError(unlist(json$error))
} else {
reportError(paste("Unexpected json response:", response$content))
}
} else if (isContentType(response$contentType, "text/html")) {
# extract body of html responses
body <- regexExtract(".*?(.*?).*", response$content)
if (response$status >= 200 && response$status < 400) {
# Good response, return the body if we have one, or the content if not
if (!is.null(body)) {
out <- body
} else {
out <- response$content
}
} else {
# Error response
if (!is.null(body)) {
reportError(body)
} else {
reportError(response$content)
}
}
} else {
# otherwise just dump the whole thing
if (response$status %in% 200:399) {
out <- response$content
} else {
reportError(response$content)
}
}
attr(out, "httpContentType") <- response$contentType
attr(out, "httpUrl") <- url
out
}
# Wrappers for HTTP methods -----------------------------------------------
GET <- function(service,
authInfo,
path,
query = NULL,
headers = list(),
timeout = NULL) {
httpRequest(service, authInfo, "GET", path, query, headers, timeout)
}
DELETE <- function(service,
authInfo,
path,
query = NULL,
headers = list()) {
httpRequest(service, authInfo, "DELETE", path, query, headers)
}
POST <- function(service,
authInfo,
path,
query = NULL,
contentType = NULL,
file = NULL,
content = NULL,
headers = list()) {
# check if the request needs a body
if ((is.null(file) && is.null(content))) {
# no file or content, don't include a body with the request
httpRequest(service, authInfo, "POST", path, query, headers)
} else {
# include the request's data in the body
httpRequestWithBody(
service = service,
authInfo = authInfo,
method = "POST",
path = path,
query = query,
contentType = contentType,
file = file,
content = content,
headers = headers
)
}
}
POST_JSON <- function(service,
authInfo,
path,
json,
query = NULL,
headers = list()) {
POST(
service = service,
authInfo = authInfo,
path = path,
query = query,
contentType = "application/json",
content = toJSON(json),
headers = headers
)
}
PUT <- function(service,
authInfo,
path,
query = NULL,
contentType = NULL,
file = NULL,
content = NULL,
headers = list()) {
httpRequestWithBody(
service = service,
authInfo = authInfo,
method = "PUT",
path = path,
query = query,
contentType = contentType,
file = file,
content = content,
headers = headers
)
}
PUT_JSON <- function(service,
authInfo,
path,
json,
query = NULL,
headers = list()) {
PUT(
service = service,
authInfo = authInfo,
path = path,
query = query,
contentType = "application/json",
content = toJSON(json),
headers = headers
)
}
PATCH <- function(service,
authInfo,
path,
query = NULL,
contentType = NULL,
file = NULL,
content = NULL,
headers = list()) {
httpRequestWithBody(
service = service,
authInfo = authInfo,
method = "PATCH",
path = path,
query = query,
contentType = contentType,
file = file,
content = content,
headers = headers
)
}
PATCH_JSON <- function(service,
authInfo,
path,
json,
query = NULL,
headers = list()) {
PATCH(
service = service,
authInfo = authInfo,
path = path,
query = query,
contentType = "application/json",
content = toJSON(json),
headers = headers
)
}
# User options ------------------------------------------------------------
httpVerbose <- function() {
getOption("rsconnect.http.verbose", FALSE)
}
httpTraceJson <- function() {
getOption("rsconnect.http.trace.json", FALSE)
}
httpTrace <- function(method, path, time) {
if (getOption("rsconnect.http.trace", FALSE)) {
cat(method, " ", path, " ", as.integer(time[["elapsed"]] * 1000), "ms\n",
sep = ""
)
}
}
httpCookies <- function() {
getOption("rsconnect.http.cookies", character())
}
httpHeaders <- function() {
getOption("rsconnect.http.headers", character())
}
httpFunction <- function() {
httpType <- getOption("rsconnect.http", "libcurl")
if (is_string(httpType) && httpType != "libcurl") {
lifecycle::deprecate_warn(
"1.0.0",
I("The `rsconnect.http` option"),
details = c(
"It should no longer be necessary to set this option",
"If the default http handler doesn't work for you, please file an issue at "
)
)
}
if (identical("libcurl", httpType)) {
httpLibCurl
} else if (identical("rcurl", httpType)) {
httpRCurl
} else if (identical("curl", httpType)) {
httpCurl
} else if (identical("internal", httpType)) {
httpInternal
} else if (is.function(httpType)) {
httpType
} else {
stop(paste(
"Invalid http option specified:", httpType,
". Valid values are libcurl, rcurl, curl, and internal"
))
}
}
# URL manipulation --------------------------------------------------------
parseHttpUrl <- function(urlText) {
matches <- regexec("(http|https)://([^:/#?]+)(?::(\\d+))?(.*)", urlText)
components <- regmatches(urlText, matches)[[1]]
if (length(components) == 0) {
stop("Invalid url: ", urlText)
}
url <- list()
url$protocol <- components[[2]]
url$host <- components[[3]]
url$port <- components[[4]]
url$path <- components[[5]]
url
}
buildHttpUrl <- function(x) {
colon <- if (!is.null(x$port) && nzchar(x$port)) ":"
paste0(x$protocol, "://", x$host, colon, x$port, x$path)
}
urlDecode <- function(x) {
curl::curl_unescape(x)
}
urlEncode <- function(x) {
if (inherits(x, "AsIs")) {
return(x)
}
RCurl::curlEscape(x)
}
buildPath <- function(apiPath, path, query = NULL) {
# prepend the service path
url <- paste(apiPath, path, sep = "")
# append the query
if (!is.null(query)) {
# URL encode query args
query <- utils::URLencode(query)
url <- paste(url, "?", query, sep = "")
}
url
}
queryString <- function(elements) {
stopifnot(is.list(elements))
elements <- elements[!sapply(elements, is.null)]
names <- curl::curl_escape(names(elements))
values <- vapply(elements, urlEncode, character(1))
if (length(elements) > 0) {
result <- paste0(names, "=", values, collapse = "&")
} else {
result <- ""
}
return(result)
}
# Auth --------------------------------------------------------------------
requestCertificate <- function(protocol, certificate = NULL) {
if (identical(protocol, "https")) {
createCertificateFile(certificate)
} else {
NULL
}
}
authHeaders <- function(authInfo, method, path, file = NULL) {
if (!is.null(authInfo$secret) || !is.null(authInfo$private_key)) {
signatureHeaders(authInfo, method, path, file)
} else if (!is.null(authInfo$apiKey)) {
list(`Authorization` = paste("Key", authInfo$apiKey))
} else {
# The value doesn't actually matter here, but the header needs to be set.
list(`X-Auth-Token` = "anonymous-access")
}
}
# https://github.com/rstudio/connect/wiki/token-authentication#request-signing-rsconnect
signatureHeaders <- function(authInfo, method, path, file = NULL) {
# headers to return
headers <- list()
# remove query string from path if necessary
path <- strsplit(path, "?", fixed = TRUE)[[1]][[1]]
# generate date
date <- rfc2616Date()
if (!is.null(authInfo$secret)) {
# the content hash is a string of hex characters when using secret.
md5 <- fileMD5(file)
# build canonical request
canonicalRequest <- paste(method, path, date, md5, sep = "\n")
# sign request using shared secret
decodedSecret <- openssl::base64_decode(authInfo$secret)
hmac <- openssl::sha256(canonicalRequest, key = decodedSecret)
signature <- paste(openssl::base64_encode(hmac), "; version=1", sep = "")
} else if (!is.null(authInfo$private_key)) {
# the raw content hash is base64 encoded hex values when using private key.
md5 <- openssl::base64_encode(fileMD5(file, raw = TRUE))
# build canonical request
canonicalRequest <- paste(method, path, date, md5, sep = "\n")
# sign request using local private key
private_key <- openssl::read_key(
openssl::base64_decode(authInfo$private_key),
der = TRUE
)
# OpenSSL defaults to sha1 hash function (which is what we need)
rawsig <- openssl::signature_create(charToRaw(canonicalRequest), key = private_key)
signature <- openssl::base64_encode(rawsig)
} else {
stop("can't sign request: no shared secret or private key")
}
# return headers
headers$Date <- date
headers$`X-Auth-Token` <- authInfo$token
headers$`X-Auth-Signature` <- signature
headers$`X-Content-Checksum` <- md5
headers
}
rfc2616Date <- function(time = Sys.time()) {
# set locale to POSIX/C to ensure ASCII date
old <- Sys.setlocale("LC_TIME", "C")
defer(Sys.setlocale("LC_TIME", old))
strftime(Sys.time(), "%a, %d %b %Y %H:%M:%S GMT", tz = "GMT")
}
# Helpers -----------------------------------------------------------------
userAgent <- function() {
paste("rsconnect", packageVersion("rsconnect"), sep = "/")
}
parseHttpHeader <- function(header) {
split <- strsplit(header, ": ")[[1]]
if (length(split) == 2) {
return(list(name = split[1], value = split[2]))
} else {
return(NULL)
}
}
parseHttpStatusCode <- function(statusLine) {
# extract status code; needs to deal with HTTP/1.0, HTTP/1.1, and HTTP/2
statusCode <- regexExtract("HTTP/[0-9]+\\.?[0-9]* ([0-9]+).*", statusLine)
if (is.null(statusCode)) {
return(-1)
} else {
return(as.integer(statusCode))
}
}
# @param request A list containing protocol, host, port, method, and path fields
# @param conn The connection to read the response from.
readHttpResponse <- function(request, conn) {
# read status code
resp <- readLines(conn, 1)
statusCode <- parseHttpStatusCode(resp[1])
# read response headers
contentLength <- NULL
contentType <- NULL
location <- NULL
setCookies <- NULL
repeat {
resp <- readLines(conn, 1)
if (nzchar(resp) == 0) {
break()
}
header <- parseHttpHeader(resp)
if (!is.null(header)) {
name <- tolower(header$name)
if (name == "content-type") {
contentType <- header$value
}
if (name == "content-length") {
contentLength <- as.integer(header$value)
}
if (name == "location") {
location <- header$value
}
if (name == "set-cookie") {
setCookies <- c(setCookies, header$value)
}
}
}
# Store the cookies that were found in the request
storeCookies(request, setCookies)
# read the response content
if (is.null(contentLength)) {
# content length is unknown, so stream remaining text
content <- paste(readLines(con = conn), collapse = "\n")
} else {
# we know the content length, so read exactly that many bytes
content <- rawToChar(readBin(
con = conn, what = "raw",
n = contentLength
))
}
# emit JSON trace if requested
if (httpTraceJson() && identical(contentType, "application/json")) {
cat(paste0(">> ", content, "\n"))
}
# return list
list(
req = request,
status = statusCode,
location = location,
contentType = contentType,
content = content
)
}
rsconnect/R/deployments-find.R 0000644 0001762 0000144 00000003341 14516247550 016067 0 ustar ligges users findDeployment <- function(appPath = getwd(),
appName = NULL,
server = NULL,
account = NULL,
error_call = caller_env()) {
deps <- deployments(
appPath,
nameFilter = appName,
serverFilter = server,
accountFilter = account
)
if (nrow(deps) == 0) {
# When the name and account information does not discover a single deployment, return a skeleton
# deployment object, which can subsequently be used to query the service.
# Infers account when not provided...
accountDetails <- accountInfo(account, server)
if (is.null(appName)) {
appName <- generateAppName(NULL, appPath, account = accountDetails$name, unique = FALSE)
}
list(
name = appName,
account = accountDetails$name,
server = accountDetails$server
)
} else if (nrow(deps) == 1) {
as.list(deps)
} else {
disambiguateDeployments(deps, error_call = error_call)
}
}
disambiguateDeployments <- function(appDeployments, error_call = caller_env()) {
if (nrow(appDeployments) == 1) {
return(appDeployments[1, ])
}
apps <- paste0(
appDeployments$name, " ",
"(", accountLabel(appDeployments$account, appDeployments$server), "): ",
"{.url ", appDeployments$url, "}"
)
not_interactive <- c(
"Please use {.arg appName}, {.arg server} or {.arg account} to disambiguate.",
"Known applications:",
set_names(apps, "*")
)
idx <- cli_menu(
"This directory has been previously deployed in multiple places.",
"Which deployment do you want to use?",
choices = apps,
not_interactive = not_interactive,
error_call = error_call
)
as.list(appDeployments[idx, ])
}
rsconnect/R/tasks.R 0000644 0001762 0000144 00000003600 14513230050 013711 0 ustar ligges users #' List Tasks
#'
#' @inheritParams deployApp
#' @return
#' Returns a data frame with the following columns:
#' \tabular{ll}{
#' `id` \tab Task id \cr
#' `action` \tab Task action\cr
#' `status` \tab Current task status\cr
#' `created_time` \tab Task creation time\cr
#' `finished_time` \tab Task finished time\cr
#' }
#' @examples
#' \dontrun{
#'
#' # list tasks for the default account
#' tasks()
#'
#' }
#' @seealso [taskLog()]
#' @export
tasks <- function(account = NULL, server = NULL) {
# resolve account and create connect client
accountDetails <- accountInfo(account, server)
client <- clientForAccount(accountDetails)
# list tasks
tasks <- client$listTasks(accountDetails$accountId)
# extract the subset of fields we're interested in
res <- lapply(tasks, `[`, c("id", "action", "status", "created_time"))
# convert to data frame
res <- do.call(rbind, res)
as.data.frame(res, stringsAsFactors = FALSE)
}
#' Show task log
#'
#' Writes the task log for the given task
#' @param taskId Task Id
#' @inheritParams deployApp
#' @param output Where to write output. Valid values are `NULL` or `stderr`
#' @examples
#' \dontrun{
#'
#' # write task log to stdout
#' taskLog(12345)
#'
#' # write task log to stderr
#' taskLog(12345, output="stderr")
#'
#' }
#' @seealso [tasks()]
#' @export
taskLog <- function(taskId, account = NULL, server = NULL, output = NULL) {
accountDetails <- accountInfo(account, server)
client <- clientForAccount(accountDetails)
if (identical(output, "stderr")) {
conn <- stderr()
} else{
conn <- ""
}
# show task log
cat(client$getTaskLogs(taskId), file = conn)
# get child tasks
tasks <- client$listTasks(accountDetails$accountId,
filters = filterQuery("parent_id", taskId))
# get child task logs
for (task in tasks) {
taskLog(task["id"], account = account, server = server, output = output)
}
}
rsconnect/R/deployDoc.R 0000644 0001762 0000144 00000005404 14513230050 014512 0 ustar ligges users #' Deploy a single document
#'
#' @description
#' Deploys a single R Markdown, Quarto document, or other file (e.g. `.html` or
#' `.pdf`).
#'
#' When deploying an `.Rmd`, `.Qmd`, or `.html`, `deployDoc()` will attempt to
#' automatically discover dependencies using [rmarkdown::find_external_resources()],
#' and include an `.Rprofile` if present. If you find that the document is
#' missing dependencies, either specify the dependencies explicitly in the
#' document (see [rmarkdown::find_external_resources()] for details), or call
#' [deployApp()] directly and specify your own file list in `appFiles`.
#'
#' @param doc Path to the document to deploy.
#' @param ... Additional arguments to [deployApp()]. Do not supply `appDir`,
#' `appFiles`, or `appPrimaryDoc`; these three parameters are automatically
#' generated by `deployDoc` from the document.
#' @inheritParams deployApp
#' @family Deployment functions
#' @export
#' @examples
#' \dontrun{
#' deployDoc("my-report.Rmd")
#' deployDoc("static-file.html")
#' }
deployDoc <- function(doc, ..., logLevel = c("normal", "quiet", "verbose")) {
logLevel <- arg_match(logLevel)
doc <- standardizeSingleDocDeployment(doc, quiet = logLevel == "quiet")
deployApp(
appDir = doc$appDir,
appPrimaryDoc = doc$appPrimaryDoc,
appFiles = doc$appFiles,
...,
logLevel = logLevel
)
}
standardizeSingleDocDeployment <- function(path,
quiet = FALSE,
error_call = caller_env(),
error_arg = caller_arg(path)) {
check_installed(
"rmarkdown",
version = "0.5.2",
reason = "to deploy individual R Markdown documents"
)
check_file(path, error_call = error_call, error_arg = error_arg)
path <- normalizePath(path)
if (isShinyRmd(path)) {
# deploy entire directory
appFiles <- NULL
} else if (isStaticFile(path)) {
taskStart(quiet, "Discovering document dependencies...")
resources <- rmarkdown::find_external_resources(path)
taskComplete(quiet, "Document dependencies discovered")
appFiles <- c(basename(path), resources$path)
if (isRenderedFile(path)) {
candidates <- c(".Rprofile", "renv.lock", "requirements.txt")
exists <- file.exists(file.path(dirname(path), candidates))
appFiles <- c(appFiles, candidates[exists])
}
appFiles
} else {
# deploy just the file
appFiles <- basename(path)
}
list(
appDir = normalizePath(dirname(path)),
appPrimaryDoc = basename(path),
appFiles = appFiles
)
}
isStaticFile <- function(path) {
ext <- tolower(tools::file_ext(path))
ext %in% c("rmd", "qmd", "html", "htm")
}
isRenderedFile <- function(path) {
ext <- tolower(tools::file_ext(path))
ext %in% c("rmd", "qmd")
}
rsconnect/R/ide.R 0000644 0001762 0000144 00000007265 14514011431 013341 0 ustar ligges users # These functions are intended to be called primarily by the RStudio IDE.
# This function is poorly named because as well as validating the server
# url it will also register the server if needed.
validateServerUrl <- function(url, certificate = NULL) {
res <- validateConnectUrl(url, certificate)
if (res$valid) {
name <- findAndRegisterLocalServer(res$url)
c(list(valid = TRUE, url = res$url, name = name), res$response)
} else {
res
}
}
# given a server URL, returns that server's short name. if the server is not
# currently registered, the server is registered and the short name of the newly
# registered server is returned.
findAndRegisterLocalServer <- function(url) {
# helper to find a server given its URL
findServerByUrl <- function(url) {
allServers <- rsconnect::servers(local = TRUE)
match <- allServers[allServers$url == url, , drop = FALSE]
if (nrow(match) == 0)
NULL
else
as.character(match[1, "name"])
}
# if there are no local servers with the given URL, add one and return its
# name
name <- findServerByUrl(url)
if (is.null(name)) {
url <- ensureConnectServerUrl(url)
addServer(
url = url,
name = NULL,
certificate = NULL,
quiet = TRUE,
validate = FALSE
)
findServerByUrl(url)
} else {
name
}
}
registerUserToken <- function(serverName, accountName, userId, token, privateKey) {
registerAccount(
serverName = serverName,
accountName = accountName,
accountId = userId,
token = token,
private_key = privateKey
)
}
# generate the markers
showRstudioSourceMarkers <- function(basePath, lint) {
markers <- list()
applied <- lapply(lint, function(file) {
lapply(file, function(linter) {
lapply(linter$indices, function(index) {
marker <- list()
marker$type <- "warning"
marker$file <- file.path(basePath, linter$file)
marker$line <- index
marker$column <- 1
marker$message <- linter$suggestion
markers <<- c(markers, list(marker))
marker
})
})
})
rstudioapi::callFun("sourceMarkers",
name = "Publish Content Issues",
markers = markers,
basePath = basePath,
autoSelect = "first")
}
# getAppById() -----------------------------------------------------------------
# https://github.com/rstudio/rstudio/blob/ee56d49b0fca5f3d7c3f5214a4010355d1bb0212/src/gwt/src/org/rstudio/studio/client/rsconnect/ui/RSConnectDeploy.java#L699
getAppById <- function(id, account, server, hostUrl) {
check_string(account)
check_string(server)
check_string(hostUrl)
if (!hasAccount(account, server)) {
# If can't find record for account + server, try hostUrl
servers <- servers()
matches <- servers$url == hostUrl
if (any(matches)) {
server <- servers$name[which(matches)[[1]]]
if (!hasAccount(account, server)) {
cli::cli_abort(
"Can't find account {.str {account}} on server {.str {server}}."
)
}
} else {
cli::cli_abort("Can't find server with url {.str {hostUrl}}.")
}
}
getApplication(account, server, id)
}
# -------------------------------------------------------------------------
# passthrough function for compatibility with old IDE versions
getUserFromRawToken <- function(serverUrl,
token,
privateKey,
serverCertificate = NULL) {
# Look up server name from url
servers <- servers()
matches <- servers$url == serverUrl
server <- servers$name[which(matches)[[1]]]
waitForAuthedUser(server, token = token, private_key = privateKey)
}
rsconnect/R/writeManifest.R 0000644 0001762 0000144 00000005720 14513230050 015412 0 ustar ligges users #' Create a `manifest.json`
#'
#' @description
#' Use `writeManifest()` to generate a `manifest.json`. Among other things,
#' you can commit this file to git to activate
#' [Git-Backed content](https://docs.posit.co/connect/user/git-backed/)
#' for Posit Connect.
#'
#' `manifest.json` contains a list of all files in the app along with their
#' dependencies, so you will need to re-run `writeManifest()` when either of
#' these change.
#'
#' @inheritParams deployApp
#' @param contentCategory Set this to `"site"` if you'd deploy with
#' [deploySite()]; otherwise leave as is.
#' @param verbose If `TRUE`, prints detailed progress messages.
#' @param quiet If `FALSE`, prints progress messages.
#' @export
writeManifest <- function(appDir = getwd(),
appFiles = NULL,
appFileManifest = NULL,
appPrimaryDoc = NULL,
appMode = NULL,
contentCategory = NULL,
python = NULL,
forceGeneratePythonEnvironment = FALSE,
quarto = NA,
image = NULL,
envManagement = NULL,
envManagementR = NULL,
envManagementPy = NULL,
verbose = FALSE,
quiet = FALSE) {
appFiles <- listDeploymentFiles(
appDir,
appFiles = appFiles,
appFileManifest = appFileManifest
)
appMetadata <- appMetadata(
appDir = appDir,
appFiles = appFiles,
appPrimaryDoc = appPrimaryDoc,
quarto = quarto,
appMode = appMode,
contentCategory = contentCategory,
)
# copy files to bundle dir to stage
bundleDir <- bundleAppDir(
appDir = appDir,
appFiles = appFiles,
appPrimaryDoc = appMetadata$appPrimaryDoc
)
defer(unlink(bundleDir, recursive = TRUE))
python <- getPython(python)
pythonConfig <- pythonConfigurator(python, forceGeneratePythonEnvironment)
# generate the manifest and write it into the bundle dir
manifest <- createAppManifest(
appDir = bundleDir,
appMetadata = appMetadata,
pythonConfig = pythonConfig,
retainPackratDirectory = FALSE,
image = image,
envManagement = envManagement,
envManagementR = envManagementR,
envManagementPy = envManagementPy,
verbose = verbose,
quiet = quiet
)
manifestJson <- toJSON(manifest)
manifestPath <- file.path(appDir, "manifest.json")
writeLines(manifestJson, manifestPath, useBytes = TRUE)
requirementsFilename <- manifest$python$package_manager$package_file
if (is.null(requirementsFilename)) {
requirementsFilename <- "requirements.txt"
}
srcRequirementsFile <- file.path(bundleDir, requirementsFilename)
dstRequirementsFile <- file.path(appDir, requirementsFilename)
if (file.exists(srcRequirementsFile) && !file.exists(dstRequirementsFile)) {
file.copy(srcRequirementsFile, dstRequirementsFile)
}
invisible()
}
rsconnect/R/lint-framework.R 0000644 0001762 0000144 00000003115 14513230050 015526 0 ustar ligges users .__LINTERS__. <- new.env(parent = emptyenv())
##' Add a Linter
##'
##' Add a linter, to be used in subsequent calls to [lint()].
##'
##' @param name The name of the linter, as a string.
##' @param linter A [linter()].
##' @export
##' @example examples/example-linter.R
addLinter <- function(name, linter) {
assign(name, linter, envir = .__LINTERS__.)
}
##' Create a Linter
##'
##' Generate a linter, which can identify errors or problematic regions in a
##' project.
##'
##' @param apply Function that, given the content of a file, returns the indices
##' at which problems were found.
##' @param takes Function that, given a set of paths, returns the subset of
##' paths that this linter uses.
##' @param message Function that, given content and lines, returns an
##' informative message for the user. Typically generated with
##' [makeLinterMessage()].
##' @param suggestion String giving a prescribed fix for the linted problem.
##' @export
##' @example examples/example-linter.R
linter <- function(apply, takes, message, suggestion) {
result <- list(
apply = apply,
takes = takes,
message = message,
suggestion = suggestion
)
class(result) <- "linter"
result
}
getLinterApplicableFiles <- function(linter, files) {
result <- linter$takes(files)
if (is.numeric(result) || is.logical(result)) {
files[result]
} else {
result
}
}
applyLinter <- function(linter, ...) {
result <- linter$apply(...)
if (is.logical(result)) {
output <- which(result)
} else {
output <- as.numeric(result)
}
attributes(output) <- attributes(result)
output
}
rsconnect/R/utils.R 0000644 0001762 0000144 00000010251 14513230050 013724 0 ustar ligges users # Returns a logging function when enabled, a noop function otherwise.
verboseLogger <- function(verbose) {
if (verbose) {
function(...) {
timestamp <- paste("[", as.character(Sys.time()), "]", sep = "")
cat(paste0(timestamp, " ", ..., "\n"))
}
} else {
function(...) {}
}
}
regexExtract <- function(re, input) {
match <- regexec(re, input)
matchLoc <- match[1][[1]]
if (length(matchLoc) > 1) {
matchLen <- attributes(matchLoc)$match.length
return(substr(input, matchLoc[2], matchLoc[2] + matchLen[2] - 1))
} else {
return(NULL)
}
}
displayStatus <- function(quiet) {
quiet <- quiet || httpDiagnosticsEnabled()
function(status) {
if (!quiet) {
cat(status)
}
}
}
httpDiagnosticsEnabled <- function() {
return(getOption("rsconnect.http.trace", FALSE) ||
getOption("rsconnect.http.verbose", FALSE))
}
# Replacement for tools::file_path_sans_ext to work around an issue where
# filenames like "foo..ext" are not returned as "foo.".
file_path_sans_ext <- function(x, compression = FALSE) {
if (compression) {
x <- sub("[.](gz|bz2|xz)$", "", x)
}
sub("(.+)\\.[[:alnum:]]+$", "\\1", x)
}
dirExists <- function(x) {
utils::file_test("-d", x)
}
# Returns the MD5 for path as a raw sequence of 16 hexadecimal pairs.
fileMD5 <- function(path, raw = FALSE) {
# Use digest::digest to compute file MD5. FIPS mode disables openssl::md5. Workaround until we can
# migrate away from MD5 for file content checks.
#
# See: https://github.com/rstudio/rsconnect/issues/363
if (is.null(path)) {
digest::digest("", algo = "md5", serialize = FALSE, raw = raw)
} else {
digest::digest(path, algo = "md5", file = TRUE, raw = raw)
}
}
check_file <- function(x,
error_arg = caller_arg(x),
error_call = caller_env()) {
check_string(
x,
allow_empty = FALSE,
error_arg = error_arg,
error_call = error_call
)
if (!file.exists(x)) {
cli::cli_abort(
"{.arg {error_arg}}, {.str {x}}, does not exist.",
call = error_call
)
}
}
check_directory <- function(x,
error_arg = caller_arg(x),
error_call = caller_env()) {
check_file(x, error_arg = error_arg, error_call = error_call)
if (!dirExists(x)) {
cli::cli_abort(
"{.arg {error_arg}}, {.str {x}}, is not a directory.",
call = error_call
)
}
}
file_size <- function(path) {
x <- file.info(path)$size
x[is.na(x)] <- 0
x
}
rbind_fill <- function(dfs, col_names = character()) {
if (length(dfs) == 0) {
df <- rep(list(logical(0)), length(col_names))
names(df) <- col_names
return(as.data.frame(df))
}
all_names <- unique(unlist(lapply(dfs, names)))
all_names <- union(col_names, all_names)
add_missing_cols <- function(df) {
df[setdiff(all_names, names(df))] <- rep(NA, nrow(df))
df
}
complete <- lapply(dfs, add_missing_cols)
out <- do.call("rbind", complete)
out[all_names]
}
# Ensure slashes are the same direction on every platform to make snapshot
# testing simpler
normalizePath <- function(path, mustWork = FALSE) {
base::normalizePath(path, winslash = "/", mustWork = mustWork)
}
compact <- function(x) {
x[!vapply(x, is.null, logical(1))]
}
hasPrefix <- function(x, prefix) {
substring(x, 1, nchar(prefix)) == prefix
}
# Lightweight equivalent of withr::defer()
defer <- function(expr, env = caller_env(), after = FALSE) {
thunk <- as.call(list(function() expr))
do.call(on.exit, list(thunk, TRUE, after), envir = env)
}
dirCreate <- function(paths) {
for (path in paths) {
dir.create(path, showWarnings = FALSE, recursive = TRUE)
}
paths
}
fromIDE <- function() {
!is.na(Sys.getenv("RSTUDIO", unset = NA)) && !identical(.Platform$GUI, "RStudio")
}
toJSON <- function(x, ...) {
jsonlite::toJSON(
x,
dataframe = "columns",
null = "null",
na = "null",
auto_unbox = TRUE,
pretty = TRUE,
digits = 30,
...
)
}
truthy <- function(value, default = FALSE) {
if (!is.atomic(value) || length(value) != 1 || is.na(value))
default
else if (is.character(value))
value %in% c("TRUE", "True", "true", "T", "1")
else
as.logical(value)
}
rsconnect/R/secret.R 0000644 0001762 0000144 00000001221 14513230050 014046 0 ustar ligges users secret <- function(x) {
if (is.null(x)) return(NULL)
stopifnot(is.character(x) || all(is.na(x)))
structure(x, class = "rsconnect_secret")
}
#' @export
format.rsconnect_secret <- function(x, ...) {
paste0(substr(x, 1, 6), "... (redacted)")
}
#' @export
print.rsconnect_secret <- function(x, ...) {
print(format(x))
invisible(x)
}
#' @export
str.rsconnect_secret <- function(object, ...) {
cat(" ", format(object), "\n", sep = "")
}
#' @export
as.data.frame.rsconnect_secret <- function(x,
...) {
structure(
list(x),
row.names = .set_row_names(length(x)),
class = "data.frame"
)
}
rsconnect/R/client-connect.R 0000644 0001762 0000144 00000013453 14513230050 015500 0 ustar ligges users # Docs: https://docs.posit.co/connect/api/
connectClient <- function(service, authInfo) {
list(
service = function() {
"connect"
},
## Server settings API
serverSettings = function() {
GET(service, authInfo, file.path("/server_settings"))
},
## User API
addUser = function(userRecord) {
userRecord <- validateUserRecord(userRecord)
POST_JSON(service, authInfo, "/users", userRecord)
},
getUser = function(userId) {
GET(service, authInfo, file.path("/users", userId))
},
currentUser = function() {
GET(service, authInfo, "/users/current")
},
## Tokens API
addToken = function(token) {
POST_JSON(service, authInfo, "/tokens", token)
},
## Applications API
listApplications = function(accountId, filters = NULL) {
if (is.null(filters)) {
filters <- vector()
}
path <- "/applications"
query <- paste(filterQuery(
c("account_id", names(filters)),
c(accountId, unname(filters))
), collapse = "&")
listApplicationsRequest(service, authInfo, path, query, "applications")
},
createApplication = function(name, title, template, accountId, appMode, contentCategory = NULL, spaceId = NULL) {
# add name; inject title if specified
details <- list(name = name)
if (!is.null(title) && nzchar(title))
details$title <- title
# RSC doesn't currently use the template or account ID
# parameters; they exist for compatibility with lucid.
application <- POST_JSON(service, authInfo, "/applications", details)
list(
id = application$id,
guid = application$guid,
url = application$url
)
},
terminateApplication = function(applicationId) {
path <- paste("/applications/", applicationId, "/terminate", sep = "")
POST_JSON(service, authInfo, path, list())
},
uploadApplication = function(appId, bundlePath) {
path <- file.path("/applications", appId, "upload")
POST(
service,
authInfo,
path,
contentType = "application/x-gzip",
file = bundlePath
)
},
deployApplication = function(application, bundleId = NULL, spaceId = NULL) {
path <- paste("/applications/", application$id, "/deploy", sep = "")
json <- list()
json$bundle <- as.numeric(bundleId)
POST_JSON(service, authInfo, path, json)
},
configureApplication = function(applicationId) {
GET(service, authInfo, paste(
"/applications/", applicationId, "/config", sep = ""))
},
getApplication = function(applicationId, deploymentRecordVersion) {
GET(service, authInfo, paste0("/applications/", applicationId))
},
## Tasks API
listTasks = function() {
path <- "/tasks"
GET(service, authInfo, path)
},
getTask = function(taskId) {
path <- file.path("/tasks", taskId)
GET(service, authInfo, path)
},
killTask = function(taskId) {
path <- file.path("/tasks", taskId, "kill")
POST_JSON(service, authInfo, path, list())
},
waitForTask = function(taskId, quiet) {
start <- 0
while (TRUE) {
path <- paste0(file.path("/tasks", taskId), "?first_status=", start)
response <- GET(service, authInfo, path)
if (length(response$status) > 0) {
messages <- unlist(response$status)
# Strip timestamps, if found
timestamp_re <- "\\d{4}/\\d{2}/\\d{2} \\d{2}:\\d{2}:\\d{2}\\.\\d{3,} "
messages <- gsub(timestamp_re, "", messages)
# Made headers more prominent.
heading <- grepl("^# ", messages)
messages[heading] <- cli::style_bold(messages[heading])
cat(paste0(messages, "\n", collapse = ""))
start <- response$last_status
}
if (length(response$finished) > 0 && response$finished) {
return(response)
}
Sys.sleep(1)
}
},
# - Environment variables -----------------------------------------------
# https://docs.posit.co/connect/api/#get-/v1/content/{guid}/environment
getEnvVars = function(guid) {
path <- file.path("/v1/content", guid, "environment")
as.character(unlist(GET(service, authInfo, path, list())))
},
setEnvVars = function(guid, vars) {
path <- file.path("/v1/content", guid, "environment")
body <- unname(Map(
function(name, value) {
list(
name = name,
value = if (is.na(value)) NULL else value
)
},
vars,
Sys.getenv(vars, unset = NA)
))
PATCH_JSON(service, authInfo, path, body)
}
)
}
# userRecord --------------------------------------------------------------
userRecord <- function(email, username, first_name, last_name, password) {
list(
email = email,
username = username,
first_name = first_name,
last_name = last_name,
password = password
)
}
prettyPasteFields <- function(message, fields) {
header <- paste(message, ":\n- ", sep = "")
body <- paste(strwrap(paste(shQuote(fields), collapse = ", ")),
collapse = "\n")
paste(header, body, sep = "")
}
validateUserRecord <- function(record) {
requiredFields <- c("email", "username", "first_name", "last_name", "password")
missingFields <- setdiff(requiredFields, names(record))
extraFields <- setdiff(names(record), requiredFields)
## Construct error message if necessary
msg <- NULL
if (length(missingFields)) {
msg <- prettyPasteFields("The following required fields are missing",
missingFields)
}
if (length(extraFields)) {
msg <- paste(msg, prettyPasteFields("The following extraneous fields were found",
extraFields))
}
if (!is.null(msg)) {
stop(msg)
}
record
}
rsconnect/R/static-analysis.R 0000644 0001762 0000144 00000000000 14435652570 015705 0 ustar ligges users rsconnect/R/auth.R 0000644 0001762 0000144 00000021747 14513230050 013541 0 ustar ligges users cleanupPasswordFile <- function(appDir) {
check_directory(appDir)
appDir <- normalizePath(appDir)
# get data dir from appDir
dataDir <- file.path(appDir, "shinyapps")
# get password file
passwordFile <- file.path(dataDir, paste("passwords", ".txt", sep = ""))
# check if password file exists
if (file.exists(passwordFile)) {
message("WARNING: Password file found! This application is configured to use scrypt ",
"authentication, which is no longer supported.\nIf you choose to proceed, ",
"all existing users of this application will be removed, ",
"and will NOT be recoverable.\nFor for more information please visit: ",
"http://shiny.rstudio.com/articles/migration.html")
response <- readline("Do you want to proceed? [Y/n]: ")
if (tolower(substring(response, 1, 1)) != "y") {
stop("Cancelled", call. = FALSE)
} else {
# remove old password file
file.remove(passwordFile)
}
}
invisible(TRUE)
}
#' Add authorized user to application
#'
#' @param email Email address of user to add.
#' @param appDir Directory containing application. Defaults to
#' current working directory.
#' @param appName Name of application.
#' @inheritParams deployApp
#' @param sendEmail Send an email letting the user know the application
#' has been shared with them.
#' @param emailMessage Optional character vector of length 1 containing a
#' custom message to send in email invitation. Defaults to NULL, which
#' will use default invitation message.
#' @seealso [removeAuthorizedUser()] and [showUsers()]
#' @note This function works only for ShinyApps servers.
#' @export
addAuthorizedUser <- function(email, appDir = getwd(), appName = NULL,
account = NULL, server = NULL, sendEmail = NULL,
emailMessage = NULL) {
accountDetails <- accountInfo(account, server)
checkShinyappsServer(accountDetails$server)
# resolve application
if (is.null(appName))
appName <- basename(appDir)
application <- resolveApplication(accountDetails, appName)
# check for and remove password file
cleanupPasswordFile(appDir)
# fetch authoriztion list
api <- clientForAccount(accountDetails)
api$inviteApplicationUser(application$id, validateEmail(email), sendEmail,
emailMessage)
message(paste("Added:", email, "to application", sep = " "))
invisible(TRUE)
}
#' Remove authorized user from an application
#'
#' @param user The user to remove. Can be id or email address.
#' @param appDir Directory containing application. Defaults to
#' current working directory.
#' @param appName Name of application.
#' @inheritParams deployApp
#' @seealso [addAuthorizedUser()] and [showUsers()]
#' @note This function works only for ShinyApps servers.
#' @export
removeAuthorizedUser <- function(user, appDir = getwd(), appName = NULL,
account = NULL, server = NULL) {
accountDetails <- accountInfo(account, server)
checkShinyappsServer(accountDetails$server)
# resolve application
if (is.null(appName))
appName <- basename(appDir)
application <- resolveApplication(accountDetails, appName)
# check and remove password file
cleanupPasswordFile(appDir)
# get users
users <- showUsers(appDir, appName, account, server)
if (is.numeric(user)) {
# lookup by id
if (user %in% users$id) {
user <- users[users$id == user, ]
} else {
stop("User ", user, " not found", call. = FALSE)
}
} else {
# lookup by email
if (user %in% users$email) {
user <- users[users$email == user, ]
} else {
stop("User \"", user, "\" not found", call. = FALSE)
}
}
# remove user
api <- clientForAccount(accountDetails)
api$removeApplicationUser(application$id, user$id)
message(paste("Removed:", user$email, "from application", sep = " "))
invisible(TRUE)
}
#' List authorized users for an application
#'
#' @param appDir Directory containing application. Defaults to
#' current working directory.
#' @param appName Name of application.
#' @inheritParams deployApp
#' @seealso [addAuthorizedUser()] and [showInvited()]
#' @note This function works only for ShinyApps servers.
#' @export
showUsers <- function(appDir = getwd(), appName = NULL, account = NULL,
server = NULL) {
accountDetails <- accountInfo(account, server)
checkShinyappsServer(accountDetails$server)
# resolve application
if (is.null(appName))
appName <- basename(appDir)
application <- resolveApplication(accountDetails, appName)
# fetch authoriztion list
api <- clientForAccount(accountDetails)
res <- api$listApplicationAuthorization(application$id)
# get interesting fields
users <- lapply(res, function(x) {
a <- list()
a$id <- x$user$id
a$email <- x$user$email
if (!is.null(x$account)) {
a$account <- x$account
} else {
a$account <- NA
}
return(a)
})
# convert to data frame
users <- do.call(rbind, users)
df <- as.data.frame(users, stringsAsFactors = FALSE)
return(df)
}
#' List invited users for an application
#'
#' @param appDir Directory containing application. Defaults to
#' current working directory.
#' @param appName Name of application.
#' @inheritParams deployApp
#' @seealso [addAuthorizedUser()] and [showUsers()]
#' @note This function works only for ShinyApps servers.
#' @export
showInvited <- function(appDir = getwd(), appName = NULL, account = NULL,
server = NULL) {
accountDetails <- accountInfo(account, server)
checkShinyappsServer(accountDetails$server)
# resolve application
if (is.null(appName))
appName <- basename(appDir)
application <- resolveApplication(accountDetails, appName)
# fetch invitation list
api <- clientForAccount(accountDetails)
res <- api$listApplicationInvitations(application$id)
# get interesting fields
users <- lapply(res, function(x) {
a <- list()
a$id <- x$id
a$email <- x$email
a$link <- x$link
a$expired <- x$expired
return(a)
})
# convert to data frame
users <- do.call(rbind, users)
df <- as.data.frame(users, stringsAsFactors = FALSE)
return(df)
}
#' Resend invitation for invited users of an application
#'
#' @param invite The invitation to resend. Can be id or email address.
#' @param regenerate Regenerate the invite code. Can be helpful is the
#' invitation has expired.
#' @param appDir Directory containing application. Defaults to
#' current working directory.
#' @param appName Name of application.
#' @inheritParams deployApp
#' @seealso [showInvited()]
#' @note This function works only for ShinyApps servers.
#' @export
resendInvitation <- function(invite, regenerate = FALSE,
appDir = getwd(), appName = NULL,
account = NULL, server = NULL) {
accountDetails <- accountInfo(account, server)
checkShinyappsServer(accountDetails$server)
# get invitations
invited <- showInvited(appDir, appName, account, server)
if (is.numeric(invite)) {
# lookup by id
if (invite %in% invited$id) {
invite <- invited[invited$id == invite, ]
} else {
stop("Invitation \"", invite, "\" not found", call. = FALSE)
}
} else {
# lookup by email
if (invite %in% invited$email) {
invite <- invited[invited$email == invite, ]
} else {
stop("Invitiation for \"", invite, "\" not found", call. = FALSE)
}
}
# resend invitation
api <- clientForAccount(accountDetails)
api$resendApplicationInvitation(invite$id, regenerate)
message(paste("Sent invitation to", invite$email, "", sep = " "))
invisible(TRUE)
}
#' (Deprecated) List authorized users for an application
#'
#' @param appDir Directory containing application. Defaults to current working
#' directory.
#' @export
authorizedUsers <- function(appDir = getwd()) {
.Deprecated("showUsers")
# read password file
path <- getPasswordFile(appDir)
if (file.exists(path)) {
passwords <- readPasswordFile(path)
} else {
passwords <- NULL
}
return(passwords)
}
validateEmail <- function(email) {
if (is.null(email) || !grepl(".+\\@.+\\..+", email)) {
stop("Invalid email address.", call. = FALSE)
}
invisible(email)
}
getPasswordFile <- function(appDir) {
check_directory(appDir)
file.path(normalizePath(appDir), "shinyapps", "passwords.txt")
}
readPasswordFile <- function(path) {
# open and read file
lines <- readLines(path)
# extract fields
fields <- do.call(rbind, strsplit(lines, ":"))
users <- fields[, 1]
hashes <- fields[, 2]
# convert to data frame
df <- data.frame(user = users, hash = hashes, stringsAsFactors = FALSE)
# return data frame
return(df)
}
writePasswordFile <- function(path, passwords) {
# open and file
f <- file(path, open = "w")
defer(close(f))
# write passwords
apply(passwords, 1, function(r) {
l <- paste(r[1], ":", r[2], "\n", sep = "")
cat(l, file = f, sep = "")
})
message("Password file updated. You must deploy your application for these changes to take effect.")
}
rsconnect/R/bundlePackageRenv.R 0000644 0001762 0000144 00000011315 14513230050 016146 0 ustar ligges users snapshotRenvDependencies <- function(bundleDir,
extraPackages = character(),
verbose = FALSE) {
recordExtraDependencies(bundleDir, extraPackages)
old <- options(
renv.verbose = FALSE,
renv.consent = TRUE
)
defer(options(old))
dependenciesLimit <- getOption("renv.config.dependencies.limit")
if (is.null(dependenciesLimit)) {
maxFiles <- getOption("rsconnect.max.bundle.files", 10000)
oldlim <- options(
renv.config.dependencies.limit = maxFiles
)
defer(options(oldlim))
}
# analyze code dependencies ourselves rather than relying on the scan during renv::snapshot, as
# that will add renv to renv.lock as a dependency.
deps <- renv::dependencies(bundleDir, root = bundleDir, progress = FALSE)
renv::snapshot(bundleDir, packages = deps$Package, prompt = FALSE)
defer(removeRenv(bundleDir))
parseRenvDependencies(bundleDir, snapshot = TRUE)
}
parseRenvDependencies <- function(bundleDir, snapshot = FALSE) {
renv <- jsonlite::read_json(renvLockFile(bundleDir))
repos <- setNames(
vapply(renv$R$Repositories, "[[", "URL", FUN.VALUE = character(1)),
vapply(renv$R$Repositories, "[[", "Name", FUN.VALUE = character(1))
)
deps <- standardizeRenvPackages(
renv$Packages,
repos,
biocPackages = biocPackages(bundleDir)
)
if (nrow(deps) == 0) {
return(data.frame())
}
deps$description <- lapply(deps$Package, package_record)
if (!snapshot) {
lib_versions <- unlist(lapply(deps$description, "[[", "Version"))
if (any(deps$Version != lib_versions)) {
cli::cli_abort(c(
"Library and lockfile are out of sync",
i = "Use renv::restore() or renv::snapshot() to synchronise",
i = "Or ignore the lockfile by adding to your .rscignore"
))
}
}
deps
}
standardizeRenvPackages <- function(packages, repos, biocPackages = NULL) {
repos <- standardizeRepos(repos)
availablePackages <- availablePackages(repos)
names(packages) <- NULL
out <- lapply(
packages,
standardizeRenvPackage,
availablePackages = availablePackages,
biocPackages = biocPackages,
repos = repos
)
out <- compact(out)
out <- lapply(out, as.data.frame, stringsAsFactors = FALSE)
rbind_fill(out)
}
standardizeRenvPackage <- function(pkg,
availablePackages,
biocPackages = NULL,
repos = character(),
bioc) {
# Convert renv source to manifest source/repository
# https://github.com/rstudio/renv/blob/0.17.2/R/snapshot.R#L730-L773
if (is.null(pkg$Repository) && !is.null(pkg$RemoteRepos) && grepl("bioconductor.org", pkg$RemoteRepos)) {
# Work around bug where renv fails to detect BioC package installed by pak
# https://github.com/rstudio/renv/issues/1202
pkg$Source <- "Bioconductor"
}
if (pkg$Source == "Repository") {
if (identical(pkg$Repository, "CRAN")) {
if (isDevVersion(pkg, availablePackages)) {
pkg$Source <- NA_character_
pkg$Repository <- NA_character_
} else {
pkg$Source <- "CRAN"
pkg$Repository <- findRepoUrl(pkg$Package, availablePackages)
}
} else {
# $Repository comes from DESCRIPTION and is set by repo, so can be
# anything. So we must look up from the package name
pkg$Repository <- findRepoUrl(pkg$Package, availablePackages)
pkg$Source <- findRepoName(pkg$Repository, repos)
}
} else if (pkg$Source == "Bioconductor") {
pkg$Repository <- findRepoUrl(pkg$Package, availablePackages)
if (is.na(pkg$Repository)) {
# Try packages defined from default bioC repos
pkg$Repository <- findRepoUrl(pkg$Package, biocPackages)
}
} else if (pkg$Source %in% c("Bitbucket", "GitHub", "GitLab")) {
pkg$Source <- tolower(pkg$Source)
} else if (pkg$Source %in% c("Local", "unknown")) {
pkg$Source <- NA_character_
pkg$Repository <- NA_character_
}
# Remove Remote fields that pak adds for "standard" installs from CRAN
if (identical(pkg$RemoteType, "standard")) {
pkg <- pkg[!grepl("^Remote", names(pkg))]
}
pkg[manifestPackageColumns(pkg)]
}
biocPackages <- function(bundleDir) {
signal("evaluating", class = "rsconnect_biocRepos") # used for testing
availablePackages(biocRepos(bundleDir))
}
biocRepos <- function(bundleDir) {
repos <- getFromNamespace("renv_bioconductor_repos", "renv")(bundleDir)
repos[setdiff(names(repos), "CRAN")]
}
renvLockFile <- function(bundleDir) {
file.path(bundleDir, "renv.lock")
}
removeRenv <- function(path, lockfile = TRUE) {
if (lockfile) {
unlink(renvLockFile(path))
}
unlink(file.path(path, "renv"), recursive = TRUE)
}
rsconnect/R/deployAPI.R 0000644 0001762 0000144 00000001636 14513230050 014421 0 ustar ligges users #' Deploy a Plumber API
#'
#' Deploys an application consisting of plumber API routes. The given directory
#' must contain a script returning a `plumb` object or a plumber API definition.
#'
#' @param api Path to the API project directory. Must contain either
#' `entrypoint.R` or `plumber.R`
#' @param ... Additional arguments to [deployApp()].
#'
#' @details Deploy a plumber API definition by either supplying a directory
#' containing `plumber.R` (an API definition) or `entrypoint.R` that returns a
#' `plumb` object created by `plumber::plumb()`. See the plumber documentation
#' for more information.
#'
#' @family Deployment functions
#' @export
deployAPI <- function(api, ...) {
check_installed(
"plumber",
version = "0.3.2",
reason = "to deploy plumber APIs"
)
check_directory(api)
# Checking for entrypoint.R or plumber.R is done in `lint-framework.R`
deployApp(appDir = api, ...)
}
rsconnect/R/bundlePackagePackrat.R 0000644 0001762 0000144 00000013712 14513230050 016624 0 ustar ligges users snapshotPackratDependencies <- function(bundleDir,
implicit_dependencies = character(),
verbose = FALSE) {
addPackratSnapshot(bundleDir, implicit_dependencies, verbose = verbose)
lockFilePath <- packratLockFile(bundleDir)
df <- as.data.frame(read.dcf(lockFilePath), stringsAsFactors = FALSE)
unlink(dirname(lockFilePath), recursive = TRUE)
# get repos defined in the lockfile
repos <- gsub("[\r\n]", " ", df[1, "Repos"])
repos <- strsplit(unlist(strsplit(repos, "\\s*,\\s*", perl = TRUE)), "=", fixed = TRUE)
repos <- setNames(
sapply(repos, "[[", 2),
sapply(repos, "[[", 1)
)
# get packages records defined in the lockfile
records <- utils::tail(df, -1)
if (nrow(records) == 0) {
return(data.frame())
}
rownames(records) <- NULL
records <- records[manifestPackageColumns(records)]
records[c("Source", "Repository")] <- standardizeRecords(records, repos)
records$description <- lapply(records$Package, package_record)
records
}
standardizeRecords <- function(records, repos) {
availablePackages <- availablePackages(repos)
repos <- standardizeRepos(repos)
rows <- lapply(seq_len(nrow(records)), function(i) {
standardizePackratPackage(records[i, ], availablePackages, repos = repos)
})
rows <- lapply(rows, as.data.frame, stringsAsFactors = FALSE)
rbind_fill(rows, c("Source", "Repository"))
}
standardizeRepos <- function(repos) {
# Ensure that each repository has a unique name
names(repos) <- ifelse(
names2(repos) == "",
paste0("repo_", seq_along(repos)),
names2(repos)
)
# And strip trailing /
repos <- gsub("/$", "", repos)
repos
}
standardizePackratPackage <- function(record, availablePackages, repos = character()) {
pkg <- record$Package
source <- record$Source
# source types are defined by packrat:
# https://github.com/rstudio/packrat/blob/v0.9.0/R/pkg.R#L328
if (source %in% c("github", "gitlab", "bitbucket")) {
# SCM information is recorded elsewhere
repository <- NA_character_
} else if (source == "source") {
# can't install source packages elsewhere
repository <- NA_character_
source <- NA_character_
} else if (source == "CustomCRANLikeRepository" && isDevVersion(record, availablePackages)) {
# Package was installed from source, but packrat guessed it was installed
# from a known repo.
repository <- NA_character_
source <- NA_character_
} else if (source %in% c("CRAN", "Bioconductor")) {
# shinyapps & posit.cloud will ignore, but connect will use (unless admin
# has set up an override)
repository <- findRepoUrl(pkg, availablePackages)
} else {
# Installed from custom repository. Find URL from available.packages()
# and then name from repos.
repository <- findRepoUrl(pkg, availablePackages)
source <- findRepoName(repository, repos)
}
list(Source = source, Repository = repository)
}
findRepoName <- function(repository, repos) {
idx <- match(repository, repos)
names(repos)[idx]
}
findRepoUrl <- function(pkg, availablePackages) {
idx <- match(pkg, availablePackages[, "Package"])
if (!is.na(idx)) {
repo <- availablePackages[[idx, "Repository"]]
# Strip `/src/contrib/*` from package repository: `contrib.url()`
# adds /src/contrib, and RSPM adds additional directories
gsub("/src/contrib.*$", "", repo)
} else {
NA_character_
}
}
isDevVersion <- function(record, availablePackages) {
idx <- match(record$Package, availablePackages[, "Package"])
if (is.na(idx)) {
return(FALSE)
}
local_version <- record$Version
repo_version <- availablePackages[idx, "Version"]
package_version(local_version) > package_version(repo_version)
}
addPackratSnapshot <- function(bundleDir,
implicit_dependencies = character(),
verbose = FALSE) {
# if we discovered any extra dependencies, write them to a file for packrat to
# discover when it creates the snapshot
recordExtraDependencies(bundleDir, implicit_dependencies)
withCallingHandlers(
performPackratSnapshot(bundleDir, verbose = verbose),
error = function(err) {
abort("Failed to snapshot dependencies", parent = err)
},
warning = function(cnd) {
invokeRestart("muffleWarning")
}
)
invisible()
}
recordExtraDependencies <- function(bundleDir, pkgs, env = caller_env()) {
if (length(pkgs) == 0) {
return()
}
depPath <- file.path(bundleDir, "__rsconnect_deps.R")
writeLines(paste0("library(", pkgs, ")\n"), depPath)
# Automatically delete when the _caller_ finishes
defer(unlink(depPath), env = env)
invisible()
}
performPackratSnapshot <- function(bundleDir, verbose = FALSE) {
# ensure we snapshot recommended packages
srp <- packrat::opts$snapshot.recommended.packages()
packrat::opts$snapshot.recommended.packages(TRUE, persist = FALSE)
defer(packrat::opts$snapshot.recommended.packages(srp, persist = FALSE))
# Force renv dependency scanning within packrat unless the option has been
# explicitly configured. This is a no-op for older versions of packrat.
renvDiscovery <- getOption("packrat.dependency.discovery.renv")
if (is.null(renvDiscovery)) {
old <- options("packrat.dependency.discovery.renv" = TRUE)
defer(options(old))
}
# attempt to eagerly load the BiocInstaller or BiocManaager package if
# installed, to work around an issue where attempts to load the package could
# fail within a 'suppressMessages()' context
packages <- c("BiocManager", "BiocInstaller")
for (package in packages) {
if (is_installed(package)) {
requireNamespace(package, quietly = TRUE)
break
}
}
suppressMessages(
packrat::.snapshotImpl(
project = bundleDir,
snapshot.sources = FALSE,
fallback.ok = TRUE,
verbose = verbose,
implicit.packrat.dependency = FALSE
)
)
invisible()
}
packratLockFile <- function(bundleDir) {
file.path(bundleDir, "packrat", "packrat.lock")
}
rsconnect/R/deployApp.R 0000644 0001762 0000144 00000066646 14536333553 014565 0 ustar ligges users #' Deploy an Application
#'
#' Deploy a [shiny][shiny::shiny-package] application, an
#' [RMarkdown][rmarkdown::rmarkdown-package] document, a plumber API, or HTML
#' content to a server.
#'
#' ## Deployment records
#'
#' When deploying an app, `deployApp()` will save a deployment record that
#' makes it easy to update the app on server from your local source code. This
#' generally means that you need to only need to supply important arguments
#' (e.g. `appName`, `appTitle`, `server`/`account`) on the first deploy, and
#' rsconnect will reuse the same settings on subsequent deploys.
#'
#' The metadata needs to make this work is stored in `{appDir}/rsconnect/`.
#' You should generally check these files into version control to ensure that
#' future you and other collaborators will publish to the same location.
#'
#' If you have lost this directory, all is not lost, as `deployApp()` will
#' attempt to rediscover existing deployments. This is easiest if you are
#' updating an app that you created, as you can just supply the `appName`
#' (and `server`/`account` if you have multiple accounts) and `deployApp()`
#' will find the existing application account. If you need to update an app
#' that was created by someone else (that you have write permission) for, you'll
#' instead need to supply the `appId`.
#'
#' @param appDir A directory containing an application (e.g. a Shiny app
#' or plumber API). Defaults to the current directory.
#' @param appFiles,appFileManifest Use `appFiles` to specify a
#' character vector of files to bundle in the app or `appManifestFiles`
#' to provide a path to a file containing a list of such files. If neither
#' are supplied, will bundle all files in `appDir`, apart from standard
#' exclusions and files listed in a `.rscignore` file. See
#' [listDeploymentFiles()] for more details.
#' @param appPrimaryDoc If the application contains more than one document, this
#' parameter indicates the primary one, as a path relative to `appDir`. Can be
#' `NULL`, in which case the primary document is inferred from the contents
#' being deployed.
#' @param appSourceDoc `r lifecycle::badge("deprecated")` Please use
#' `recordDir` instead.
#' @param appName Application name, a string consisting of letters, numbers,
#' `_` and `-`. The application name is used to identify applications on a
#' server, so must be unique.
#'
#' If not specified, the first deployment will be automatically it from the
#' `appDir` for directory and website, and from the `appPrimaryDoc` for
#' document. On subsequent deploys, it will use the previously stored value.
#' @param appTitle Free-form descriptive title of application. Optional; if
#' supplied, will often be displayed in favor of the name. If ommitted,
#' on second and subsequent deploys, the title will be unchanged.
#' @param envVars A character vector giving the names of environment variables
#' whose values should be synchronised with the server (currently supported by
#' Connect only). The values of the environment variables are sent over an
#' encrypted connection and are not stored in the bundle, making this a safe
#' way to send private data to Connect.
#'
#' The names (not values) are stored in the deployment record so that future
#' deployments will automatically update their values. Other environment
#' variables on the server will not be affected. This means that removing an
#' environment variable from `envVars` will leave it unchanged on the server.
#' To remove it, either delete it using the Connect UI, or temporarily unset
#' it (with `Sys.unsetenv()` or similar) then re-deploy.
#'
#' Environment variables are set prior to deployment so that your code
#' can use them and the first deployment can still succeed. Note that means
#' that if the deployment fails, the values will still be updated.
#' @param appId Use this to deploy to an exact known application, ignoring all
#' existing deployment records and `appName`.
#'
#' You can use this to update an existing application that is missing a
#' deployment record. If you're re-deploying an application that you
#' created it's generally easier to use `appName`; `appId` is best reserved
#' for re-deploying apps created by someone else.
#'
#' You can find the `appId` in the following places:
#' * On shinyapps.io, it's the `id` listed on the applications page.
#' * For Posit Connect, it's `guid` from the info tab on the content page.
#' @param appMode Optional; the type of content being deployed.
#' Provide this option when the inferred type of content is incorrect. This
#' can happen, for example, when static HTML content includes a downloadable
#' Shiny application `app.R`. Accepted values include `"shiny"`, `"api"`,
#' `"rmd-static"`, `"rmd-shiny"`, `"quarto-static"`, `"quarto-shiny"`, and
#' `"static"`. The Posit Connect API Reference contains a full set of
#' available values. Not all servers support all types of content.
#' @param contentCategory Optional; classifies the kind of content being
#' deployed (e.g. `"plot"` or `"site"`).
#' @param account,server Uniquely identify a remote server with either your
#' user `account`, the `server` name, or both. If neither are supplied, and
#' there are multiple options, you'll be prompted to pick one.
#'
#' Use [accounts()] to see the full list of available options.
#' @param upload If `TRUE` (the default) then the application is uploaded from
#' the local system prior to deployment. If `FALSE` then it is re-deployed
#' using the last version that was uploaded. `FALSE` is only supported on
#' shinyapps.io; `TRUE` is required on Posit Connect.
#' @param recordDir Directory where deployment record is written. The default,
#' `NULL`, uses `appDir`, since this is usually where you want the deployment
#' data to be stored. This argument is typically only needed when deploying
#' a directory of static files since you want to store the record with the
#' code that generated those files, not the files themselves.
#' @param launch.browser If true, the system's default web browser will be
#' launched automatically after the app is started. Defaults to `TRUE` in
#' interactive sessions only. If a function is passed, it will be called
#' after the app is started, with the app URL as a paramter.
#' @param on.failure Function to be called if the deployment fails. If a
#' deployment log URL is available, it's passed as a parameter.
#' @param logLevel One of `"quiet"`, `"normal"` or `"verbose"`; indicates how
#' much logging to the console is to be performed. At `"quiet"` reports no
#' information; at `"verbose"`, a full diagnostic log is captured.
#' @param lint Lint the project before initiating deployment, to identify
#' potentially problematic code?
#' @param metadata Additional metadata fields to save with the deployment
#' record. These fields will be returned on subsequent calls to
#' [deployments()].
#'
#' Multi-value fields are recorded as comma-separated values and returned in
#' that form. Custom value serialization is the responsibility of the caller.
#' @param forceUpdate What should happen if there's no deployment record for
#' the app, but there's an app with the same name on the server? If `TRUE`,
#' will always update the previously-deployed app. If `FALSE`, will ask
#' the user what to do, or fail if not in an interactive context.
#'
#' Defaults to `TRUE` when called automatically by the IDE, and `FALSE`
#' otherwise. You can override the default by setting option
#' `rsconnect.force.update.apps`.
#' @param python Full path to a python binary for use by `reticulate`.
#' Required if `reticulate` is a dependency of the app being deployed.
#' If python = NULL, and RETICULATE_PYTHON or RETICULATE_PYTHON_FALLBACK is
#' set in the environment, its value will be used. The specified python binary
#' will be invoked to determine its version and to list the python packages
#' installed in the environment.
#' @param forceGeneratePythonEnvironment Optional. If an existing
#' `requirements.txt` file is found, it will be overwritten when this argument
#' is `TRUE`.
#' @param quarto Should the deployed content be built by quarto?
#' (`TRUE`, `FALSE`, or `NA`). The default, `NA`, will use quarto if
#' there are `.qmd` files in the bundle, or if there is a
#' `_quarto.yml` and `.Rmd` files.
#'
#' (This option is ignored and quarto will always be used if the
#' `metadata` contains `quarto_version` and `quarto_engines` fields.)
#' @param appVisibility One of `NULL`, `"private"`, or `"public"`; the
#' visibility of the deployment. When `NULL`, no change to visibility is
#' made. Currently has an effect only on deployments to shinyapps.io.
#' @param image Optional. The name of the image to use when building and
#' executing this content. If none is provided, Posit Connect will
#' attempt to choose an image based on the content requirements.
#' @param envManagement Optional. Should Posit Connect install R and Python
#' packages for this content? (`TRUE`, `FALSE`, or `NULL`).
#' The default, `NULL`, will not write any values to the bundle manifest,
#' and Connect will fall back to the application default environment
#' management strategy, or the server default if no application default
#' is defined.
#'
#' (This option is a shorthand flag which overwrites the values of both
#' `envManagementR` and `envManagementPy`.)
#' @param envManagementR Optional. Should Posit Connect install R packages
#' for this content? (`TRUE`, `FALSE`, or `NULL`). The default, `NULL`, will
#' not write any values to the bundle manifest, and Connect will fall back to
#' the application default R environment management strategy, or the server
#' default if no application default is defined.
#'
#' (This option is ignored when `envManagement` is non-`NULL`.)
#' @param envManagementPy Optional. Should Posit Connect install Python packages
#' for this content? (`TRUE`, `FALSE`, or `NULL`). The default, `NULL`, will
#' not write any values to the bundle manifest, and Connect will fall back to
#' the application default Python environment management strategy, or the
#' server default if no application default is defined.
#'
#' (This option is ignored when `envManagement` is non-`NULL`.)
#' @param space Optional. For Posit Cloud, the id of the space where the content
#' should be deployed. If none is provided, content will be deployed to the
#' deploying user's workspace or deployed to the same space in case of
#' redeploy.
#' @examples
#' \dontrun{
#'
#' # deploy the application in the current working dir
#' deployApp()
#'
#' # deploy an application in another directory
#' deployApp("~/projects/shiny/app1")
#'
#' # deploy using an alternative application name and title
#' deployApp("~/projects/shiny/app1", appName = "myapp",
#' appTitle = "My Application")
#'
#' # deploy specifying an explicit account name, then
#' # redeploy with no arguments (will automatically use
#' # the previously specified account)
#' deployApp(account = "jsmith")
#' deployApp()
#'
#' # deploy but don't launch a browser when completed
#' deployApp(launch.browser = FALSE)
#'
#' # deploy a Quarto website, using the quarto package to
#' # find the Quarto binary
#' deployApp("~/projects/quarto/site1")
#'
#' # deploy application with environment variables
#' # (e.g., `SECRET_PASSWORD=XYZ` is set via an ~/.Renviron file)
#' rsconnect::deployApp(envVars = c("SECRET_PASSWORD"))
#' }
#' @seealso [applications()], [terminateApp()], and [restartApp()]
#' @family Deployment functions
#' @export
deployApp <- function(appDir = getwd(),
appFiles = NULL,
appFileManifest = NULL,
appPrimaryDoc = NULL,
appSourceDoc = NULL,
appName = NULL,
appTitle = NULL,
envVars = NULL,
appId = NULL,
appMode = NULL,
contentCategory = NULL,
account = NULL,
server = NULL,
upload = TRUE,
recordDir = NULL,
launch.browser = getOption("rsconnect.launch.browser",
is_interactive()),
on.failure = NULL,
logLevel = c("normal", "quiet", "verbose"),
lint = TRUE,
metadata = list(),
forceUpdate = NULL,
python = NULL,
forceGeneratePythonEnvironment = FALSE,
quarto = NA,
appVisibility = NULL,
image = NULL,
envManagement = NULL,
envManagementR = NULL,
envManagementPy = NULL,
space = NULL
) {
check_string(appDir)
if (isStaticFile(appDir) && !dirExists(appDir)) {
lifecycle::deprecate_warn(
when = "1.0.0",
what = "deployApp(appDir = 'takes a directory, not a document,')",
with = "deployDoc()"
)
return(deployDoc(
appDir,
appName = appName,
appTitle = appTitle,
account = account,
server = server,
upload = upload,
recordDir = recordDir,
launch.browser = launch.browser,
logLevel = logLevel,
lint = lint
))
}
check_directory(appDir)
appDir <- normalizePath(appDir)
check_string(appName, allow_null = TRUE)
if (!is.null(appPrimaryDoc)) {
check_string(appPrimaryDoc)
if (!file.exists(file.path(appDir, appPrimaryDoc))) {
cli::cli_abort("`appPrimaryDoc` not found inside `appDir`")
}
}
if (!is.null(appSourceDoc)) {
# Used by IDE so can't deprecate
recordDir <- appSourceDoc
}
# set up logging helpers
logLevel <- match.arg(logLevel)
quiet <- identical(logLevel, "quiet")
verbose <- identical(logLevel, "verbose")
logger <- verboseLogger(verbose)
displayStatus <- displayStatus(quiet)
# run startup scripts to pick up any user options and establish pre/post deploy hooks
runStartupScripts(appDir, quiet = quiet, verbose = verbose)
# at verbose log level, turn on all tracing options implicitly for the
# duration of the call
if (verbose) {
old_verbose <- options(
rsconnect.http.trace = TRUE,
rsconnect.http.trace.json = TRUE,
rsconnect.error.trace = TRUE
)
defer(options(old_verbose))
}
# install error handler if requested
if (isTRUE(getOption("rsconnect.error.trace"))) {
old_error <- options(error = function(e) {
cat("----- Deployment error -----\n")
cat(geterrmessage(), "\n")
cat("----- Error stack trace -----\n")
traceback(x = sys.calls(), max.lines = 3)
})
defer(options(old_error))
}
# at verbose log level, generate header
if (verbose) {
logger("Deployment log started")
cat("Deploy command:", "\n", deparse(sys.call(1)), "\n\n")
cat("Session information: \n")
print(utils::sessionInfo())
}
# invoke pre-deploy hook if we have one
runDeploymentHook(appDir, "rsconnect.pre.deploy", verbose = verbose)
appFiles <- listDeploymentFiles(appDir, appFiles, appFileManifest)
if (isTRUE(lint)) {
lintResults <- lint(appDir, appFiles, appPrimaryDoc)
showLintResults(appDir, lintResults)
}
if (!quiet) {
cli::cli_rule("Preparing for deployment")
}
forceUpdate <- forceUpdate %||% getOption("rsconnect.force.update.apps") %||% fromIDE()
# determine the target deployment record and deploying account
recordPath <- findRecordPath(appDir, recordDir, appPrimaryDoc)
target <- findDeploymentTarget(
recordPath = recordPath,
appId = appId,
appName = appName,
appTitle = appTitle,
envVars = envVars,
account = account,
server = server,
forceUpdate = forceUpdate
)
accountDetails <- target$accountDetails
deployment <- target$deployment
if (is.null(deployment$appId)) {
dest <- accountLabel(accountDetails$name, accountDetails$server)
taskComplete(quiet, "Deploying {.val {deployment$name}} using {.val {dest}}")
} else {
dest <- accountLabel(accountDetails$name, accountDetails$server)
taskComplete(quiet, "Re-deploying {.val {deployment$name}} using {.val {dest}}")
}
# Run checks prior to first saveDeployment() to avoid errors that will always
# prevent a successful upload from generating a partial deployment
if (!isCloudServer(accountDetails$server) && identical(upload, FALSE)) {
# it is not possible to deploy to Connect without uploading
stop("Posit Connect does not support deploying without uploading. ",
"Specify upload=TRUE to upload and re-deploy your application.")
}
if (!isConnectServer(accountDetails$server) && length(envVars) > 1) {
cli::cli_abort("{.arg envVars} only supported for Posit Connect servers")
}
client <- clientForAccount(accountDetails)
if (verbose) {
showCookies(serverInfo(accountDetails$server)$url)
}
isShinyappsServer <- isShinyappsServer(accountDetails$server)
logger("Inferring App mode and parameters")
appMetadata <- appMetadata(
appDir = appDir,
appFiles = appFiles,
appPrimaryDoc = appPrimaryDoc,
quarto = quarto,
appMode = appMode,
contentCategory = contentCategory,
isShinyappsServer = isShinyappsServer,
metadata = metadata
)
if (is.null(deployment$appId)) {
taskStart(quiet, "Creating application on server...")
application <- client$createApplication(
deployment$name,
deployment$title,
"shiny",
accountDetails$accountId,
appMetadata$appMode,
contentCategory,
space
)
taskComplete(quiet, "Created application with id {.val {application$id}}")
} else {
taskStart(quiet, "Looking up application with id {.val {deployment$appId}}...")
application <- tryCatch(
{
application <- client$getApplication(deployment$appId, deployment$version)
taskComplete(quiet, "Found application {.url {application$url}}")
if (identical(application$type, "static")) {
application$application_id <- client$createRevision(application, contentCategory)
}
application
},
rsconnect_http_404 = function(err) {
application <- applicationDeleted(client, deployment, recordPath, appMetadata)
taskComplete(quiet, "Created application with id {.val {application$id}}")
application
}
)
}
saveDeployment(
recordPath,
deployment = deployment,
application = application,
metadata = metadata
)
# Change _visibility_ & set env vars before uploading contents
if (needsVisibilityChange(accountDetails$server, application, appVisibility)) {
taskStart(quiet, "Setting visibility to {appVisibility}...")
client$setApplicationProperty(
application$id,
"application.visibility",
appVisibility
)
taskComplete(quiet, "Visibility updated")
}
if (length(deployment$envVars) > 0) {
taskStart(quiet, "Updating environment variables {envVars}...")
client$setEnvVars(application$guid, deployment$envVars)
taskComplete(quiet, "Environment variables updated")
}
if (upload) {
python <- getPythonForTarget(python, accountDetails)
pythonConfig <- pythonConfigurator(python, forceGeneratePythonEnvironment)
taskStart(quiet, "Bundling {length(appFiles)} file{?s}: {.file {appFiles}}")
bundlePath <- bundleApp(
appName = deployment$name,
appDir = appDir,
appFiles = appFiles,
appMetadata = appMetadata,
quiet = quiet,
verbose = verbose,
pythonConfig = pythonConfig,
image = image,
envManagement = envManagement,
envManagementR = envManagementR,
envManagementPy = envManagementPy
)
size <- format(file_size(bundlePath), big.mark = ",")
taskComplete(quiet, "Created {size}b bundle")
# create, and upload the bundle
taskStart(quiet, "Uploading bundle...")
if (isCloudServer(accountDetails$server)) {
bundle <- uploadCloudBundle(client, application$application_id, bundlePath)
} else {
bundle <- client$uploadApplication(application$id, bundlePath)
}
taskComplete(quiet, "Uploaded bundle with id {.val {bundle$id}}")
saveDeployment(
recordPath,
deployment = deployment,
application = application,
bundleId = bundle$id,
metadata = metadata
)
} else {
# redeploy current bundle
bundle <- application$deployment$bundle
}
if (!quiet) {
cli::cli_rule("Deploying to server")
}
task <- client$deployApplication(application, bundle$id, space)
taskId <- if (is.null(task$task_id)) task$id else task$task_id
# wait for the deployment to complete (will raise an error if it can't)
response <- client$waitForTask(taskId, quiet)
if (!quiet) {
cli::cli_rule("Deployment complete")
}
# wait 1/10th of a second for any queued output get picked by RStudio
# before emitting the final status, to ensure it's the last line the user sees
Sys.sleep(0.10)
deploymentSucceeded <- is.null(response$code) || response$code == 0
if (!quiet) {
if (deploymentSucceeded) {
cli::cli_alert_success("Successfully deployed to {.url {application$url}}")
} else {
cli::cli_alert_danger("Deployment failed with error: {response$error}")
}
}
if (!quiet)
openURL(client, application, launch.browser, on.failure, deploymentSucceeded)
# invoke post-deploy hook if we have one
if (deploymentSucceeded) {
runDeploymentHook(appDir, "rsconnect.post.deploy", verbose = verbose)
}
logger("Deployment log finished")
invisible(deploymentSucceeded)
}
taskStart <- function(quiet, message, .envir = caller_env()) {
if (quiet) return()
cli::cli_alert_info(message, .envir = .envir)
}
taskComplete <- function(quiet, message, .envir = caller_env()) {
if (quiet) return()
cli::cli_alert_success(message, .envir = .envir)
}
findRecordPath <- function(appDir,
recordDir = NULL,
appPrimaryDoc = NULL) {
if (!is.null(recordDir)) {
recordDir
} else if (!is.null(appPrimaryDoc)) {
file.path(appDir, appPrimaryDoc)
} else {
appDir
}
}
# Need to set _before_ deploy
needsVisibilityChange <- function(server, application, appVisibility = NULL) {
if (is.null(appVisibility)) {
return(FALSE)
}
if (isConnectServer(server)) {
# Defaults to private visibility
return(FALSE)
}
if (!isShinyappsServer(server)) {
cli::cli_abort(c(
"Can't change cloud app visiblity from {.fun deployApp}.",
i = "Please change on posit.cloud instead."
))
}
cur <- application$deployment$properties$application.visibility
if (is.null(cur)) {
cur <- "public"
}
cur != appVisibility
}
runDeploymentHook <- function(appDir, option, verbose = FALSE) {
hook <- getOption(option)
if (!is.function(hook)) {
return()
}
if (verbose) {
cat("Invoking `", option, "` hook\n", sep = "")
}
hook(appDir)
}
applicationDeleted <- function(client, deployment, recordPath, appMetadata) {
header <- "Failed to find existing application on server; it's probably been deleted."
not_interactive <- c(
i = "Use {.fn forgetDeployment} to remove outdated record and try again.",
i = "Or use {.fn applications} to see other applications you have on the server."
)
prompt <- "What do you want to do?"
choices <- c(
"Give up and try again later",
"Delete existing deployment & create a new app"
)
cli_menu(header, prompt, choices, not_interactive = not_interactive, quit = 1)
# Must be option 2
path <- deploymentConfigFile(
recordPath,
deployment$name,
deployment$account,
deployment$server
)
unlink(path)
accountDetails <- accountInfo(deployment$account, deployment$server)
client$createApplication(
deployment$name,
deployment$title,
"shiny",
accountDetails$accountId,
appMetadata$appMode
)
}
# Does almost exactly the same work as writeManifest(), but called within
# deployApp() instead of being exposed to the user. Returns the path to the
# bundle directory, whereas writeManifest() returns nothing and deletes the
# bundle directory after writing the manifest.
bundleApp <- function(appName,
appDir,
appFiles,
appMetadata,
verbose = FALSE,
quiet = FALSE,
pythonConfig = NULL,
image = NULL,
envManagement = NULL,
envManagementR = NULL,
envManagementPy = NULL) {
logger <- verboseLogger(verbose)
# get application users (for non-document deployments)
users <- NULL
if (is.null(appMetadata$appPrimaryDoc)) {
users <- suppressWarnings(authorizedUsers(appDir))
}
# copy files to bundle dir to stage
logger("Bundling app dir")
bundleDir <- bundleAppDir(
appDir = appDir,
appFiles = appFiles,
appPrimaryDoc = appMetadata$appPrimaryDoc)
defer(unlink(bundleDir, recursive = TRUE))
# generate the manifest and write it into the bundle dir
logger("Generate manifest.json")
manifest <- createAppManifest(
appDir = bundleDir,
appMetadata = appMetadata,
users = users,
pythonConfig = pythonConfig,
retainPackratDirectory = TRUE,
image = image,
envManagement = envManagement,
envManagementR = envManagementR,
envManagementPy = envManagementPy,
verbose = verbose,
quiet = quiet
)
manifestJson <- toJSON(manifest)
manifestPath <- file.path(bundleDir, "manifest.json")
writeLines(manifestJson, manifestPath, useBytes = TRUE)
# create the bundle and return its path
logger("Compressing the bundle")
bundlePath <- tempfile("rsconnect-bundle", fileext = ".tar.gz")
writeBundle(bundleDir, bundlePath)
bundlePath
}
validURL <- function(url) {
!(is.null(url) || url == "")
}
openURL <- function(client, application, launch.browser, on.failure, deploymentSucceeded) {
# function to browse to a URL using user-supplied browser (config or final)
showURL <- function(url) {
if (isTRUE(launch.browser))
utils::browseURL(url)
else if (is.function(launch.browser))
launch.browser(url)
}
# Check to see if we should open config url or app url
if (!is.null(client$configureApplication)) {
config <- client$configureApplication(application$id)
url <- config$config_url
if (!deploymentSucceeded && validURL(config$logs_url)) {
# With 1.5.5+, Connect application configuration includes
# a logs URL to be shown on unsuccessful deployment.
url <- config$logs_url
}
if (validURL(url)) {
# Connect should always end up here, even on deployment failures
if (deploymentSucceeded) {
showURL(url)
} else if (is.function(on.failure)) {
on.failure(url)
}
}
} else if (deploymentSucceeded) {
# shinyapps.io should land here if things succeeded
showURL(application$url)
} else if (is.function(on.failure)) {
on.failure(NULL)
}
# or open no url if things failed
}
runStartupScripts <- function(appDir, quiet = FALSE, verbose = FALSE) {
scripts <- c(
# the site-wide startup script
file.path(R.home("etc"), "rsconnect.site"),
# the user startup script
path.expand("~/.rsconnect_profile"),
# a startup script specific to this application
file.path(appDir, ".rsconnect_profile")
)
scripts <- scripts[file.exists(scripts)]
# iterate over the startup scripts
for (script in scripts) {
taskStart(quiet, "Running {script}")
env <- new_environment(parent = globalenv())
source(script, verbose = verbose, local = env)
}
}
rsconnect/R/envvars.R 0000644 0001762 0000144 00000004666 14513230050 014265 0 ustar ligges users #' Maintain environment variables across multiple applications
#'
#' @description
#' * `listAccountEnvVars()` lists the environment variables used by
#' every application published to the specified account.
#' * `updateAccountEnvVars()` updates the specified environment variables with
#' their current values for every app that uses them.
#'
#' Secure environment variable are currently only supported by Posit Connect
#' so other server types will generate an error.
#'
#' @inheritParams deployApp
#' @export
#' @return `listAccountEnvVars()` returns a data frame with one row
#' for each data frame. It has variables `id`, `guid`, `name`, and
#' `envVars`. `envVars` is a list-column.
listAccountEnvVars <- function(server = NULL, account = NULL) {
accountDetails <- accountInfo(account, server)
checkServerHasEnvVars(accountDetails$server)
apps <- applications(
account = accountDetails$name,
server = accountDetails$server
)
apps <- apps[c("id", "guid", "name")]
client <- clientForAccount(accountDetails)
envVars <- lapply(apps$guid, client$getEnvVars)
apps$envVars <- envVars
apps
}
#' @export
#' @rdname listAccountEnvVars
#' @param envVars Names of environment variables to update. Their
#' values will be automatically retrieved from the current process.
#'
#' If you specify multiple environment variables, any application that
#' uses any of them will be updated with all of them.
updateAccountEnvVars <- function(envVars, server = NULL, account = NULL) {
check_character(envVars)
accountDetails <- accountInfo(account, server)
checkServerHasEnvVars(accountDetails$server)
apps <- listAccountEnvVars(
account = accountDetails$name,
server = accountDetails$server
)
uses_vars <- vapply(apps$envVars, function(x) any(envVars %in% x), logical(1))
if (!any(uses_vars)) {
cli::cli_abort("No applications use environment variable{?s} {.arg {envVars}}")
}
guids <- apps$guid[uses_vars]
cli::cli_progress_bar("Updating application...", total = length(guids))
client <- clientForAccount(accountDetails)
for (guid in guids) {
client$setEnvVars(guid, envVars)
cli::cli_progress_update()
}
}
# Helpers -----------------------------------------------------------------
checkServerHasEnvVars <- function(server, error_call = caller_env()) {
if (isConnectServer(server)) {
return()
}
cli::cli_abort(
"The {.arg server} {.str server} does not support environment variables"
)
}
rsconnect/R/client-cloud.R 0000644 0001762 0000144 00000031714 14513230050 015155 0 ustar ligges users # Docs: https://build.posit.it/job/hostedapps/job/lucid-pipeline/job/main/API/
getCurrentProjectId <- function(service, authInfo) {
currentApplicationId <- Sys.getenv("LUCID_APPLICATION_ID")
if (currentApplicationId != "") {
path <- paste0("/applications/", currentApplicationId)
current_application <- GET(service, authInfo, path)
return(current_application$content_id)
}
}
cloudClient <- function(service, authInfo) {
list(
status = function() {
GET(service, authInfo, "/internal/status")
},
service = function() {
"posit.cloud"
},
currentUser = function() {
GET(service, authInfo, "/users/current/")
},
accountsForUser = function(userId) {
path <- "/accounts/"
query <- ""
listRequest(service, authInfo, path, query, "accounts")
},
getAccountUsage = function(accountId, usageType = "hours", applicationId = NULL,
from = NULL, until = NULL, interval = NULL) {
path <- paste0("/accounts/", accountId, "/usage/", usageType, "/")
query <- list()
if (!is.null(applicationId))
query$application <- applicationId
if (!is.null(from))
query$from <- from
if (!is.null(until))
query$until <- until
if (!is.null(interval))
query$interval <- interval
GET(service, authInfo, path, queryString(query))
},
getBundle = function(bundleId) {
path <- paste0("/bundles/", bundleId)
GET(service, authInfo, path)
},
updateBundleStatus = function(bundleId, status) {
path <- paste0("/bundles/", bundleId, "/status")
json <- list()
json$status <- status
POST_JSON(service, authInfo, path, json)
},
createBundle = function(application, content_type, content_length, checksum) {
json <- list()
json$application <- application
json$content_type <- content_type
json$content_length <- content_length
json$checksum <- checksum
POST_JSON(service, authInfo, "/bundles", json)
},
listApplications = function(accountId, filters = list()) {
path <- "/applications/"
query <- paste(filterQuery(
c("account_id", "type", names(filters)),
c(accountId, "connect", unname(filters))
), collapse = "&")
listRequest(service, authInfo, path, query, "applications")
},
getApplication = function(outputOrApplicationId, deploymentRecordVersion) {
# The IDE doesn't know whether the id is for a content or an application, so we
# support both.
if (is.na(deploymentRecordVersion)) {
# In pre-versioned dcf files, outputOrApplicationId is the id of the application.
# TODO: consider removing support for this case a year after the release of 1.0.0
path <- paste0("/applications/", outputOrApplicationId)
application <- GET(service, authInfo, path)
output_id <- application$output_id %||% application$content_id
path <- paste0("/outputs/", output_id)
output <- GET(service, authInfo, path)
} else if (deploymentRecordVersion == "unknown") {
handleError <- function(err) {
path <- paste0("/applications/", outputOrApplicationId)
application <- GET(service, authInfo, path)
output_id <- application$output_id %||% application$content_id
path <- paste0("/outputs/", output_id)
output <- GET(service, authInfo, path)
list(application = application, output = output)
}
applicationAndOutput <- tryCatch(
{
path <- paste0("/outputs/", outputOrApplicationId)
output <- GET(service, authInfo, path)
path <- paste0("/applications/", output$source_id)
application <- GET(service, authInfo, path)
list(application = application, output = output)
},
rsconnect_http_403 = handleError,
rsconnect_http_404 = handleError
)
application <- applicationAndOutput$application
output <- applicationAndOutput$output
} else {
# from dcf version >= 1, outputOrApplicationId is the id of the output.
path <- paste0("/outputs/", outputOrApplicationId)
output <- GET(service, authInfo, path)
path <- paste0("/applications/", output$source_id)
application <- GET(service, authInfo, path)
application
}
# if the output is trashed or archived, restore it to the active state
if (output$state == "trashed" || output$state == "archived") {
json <- list()
json$state <- "active"
PATCH_JSON(service, authInfo, paste0("/outputs/", output$id), json)
}
# Each redeployment of a static output creates a new application. Since
# those applications can be deleted, it's more reliable to reference
# outputs by their own id instead of the applications'.
application$application_id <- application$id
application$id <- output$id
application$url <- output$url
application$name <- output$name
application
},
getApplicationMetrics = function(applicationId, series, metrics, from = NULL, until = NULL, interval = NULL) {
path <- paste0("/applications/", applicationId, "/metrics/", series, "/")
query <- list()
m <- paste(lapply(metrics, function(x) { paste("metric", urlEncode(x), sep = "=") }), collapse = "&")
if (!is.null(from))
query$from <- from
if (!is.null(until))
query$until <- until
if (!is.null(interval))
query$interval <- interval
GET(service, authInfo, path, paste(m, queryString(query), sep = "&"))
},
getLogs = function(applicationId, entries = 50) {
path <- paste0("/applications/", applicationId, "/logs")
query <- paste0("count=", entries, "&tail=0")
GET(service, authInfo, path, query)
},
createApplication = function(name, title, template, accountId, appMode, contentCategory = NULL, spaceId = NULL) {
json <- list()
json$name <- name
json$application_type <- if (appMode %in% c("rmd-static", "quarto-static", "static")) "static" else "connect"
if (appMode %in% c("rmd-static", "quarto-static")) {
json$render_by <- "server"
}
currentProjectId <- getCurrentProjectId(service, authInfo)
# in case the source cloud project is a temporary copy, there is no
# content id. The output will be published without a space id.
if (!is.null(currentProjectId)) {
json$project <- currentProjectId
path <- paste0("/content/", currentProjectId)
currentProject <- GET(service, authInfo, path)
json$space <- currentProject$space_id
}
json$content_category <- contentCategory
if (is.null(currentProjectId) && !is.null(spaceId)) {
json$space <- spaceId
}
output <- POST_JSON(service, authInfo, "/outputs", json)
path <- paste0("/applications/", output$source_id)
application <- GET(service, authInfo, path)
list(
id = output$id,
application_id = application$id,
url = output$url
)
},
listApplicationProperties = function(applicationId) {
path <- paste0("/applications/", applicationId, "/properties/")
GET(service, authInfo, path)
},
setApplicationProperty = function(applicationId, propertyName,
propertyValue, force = FALSE) {
path <- paste0("/applications/", applicationId, "/properties/",
propertyName)
v <- list()
v$value <- propertyValue
query <- paste0("force=", if (force) "1" else "0")
PUT_JSON(service, authInfo, path, v, query)
},
unsetApplicationProperty = function(applicationId, propertyName,
force = FALSE) {
path <- paste0("/applications/", applicationId, "/properties/",
propertyName)
query <- paste0("force=", if (force) "1" else "0")
DELETE(service, authInfo, path, query)
},
uploadApplication = function(applicationId, bundlePath) {
path <- paste0("/applications/", applicationId, "/upload")
POST(
service,
authInfo,
path,
contentType = "application/x-gzip",
file = bundlePath
)
},
createRevision = function(application, contentCategory) {
path <- paste0("/outputs/", application$id, "/revisions")
json <- list(content_category = contentCategory)
revision <- POST_JSON(service, authInfo, path, json)
revision$application_id
},
deployApplication = function(application, bundleId = NULL, spaceId = NULL) {
currentProjectId <- getCurrentProjectId(service, authInfo)
if (!is.null(currentProjectId)) {
PATCH_JSON(service, authInfo, paste0("/outputs/", application$id), list(project = currentProjectId))
}
if (!is.null(spaceId)) {
PATCH_JSON(service, authInfo, paste0("/outputs/", application$id), list(space = spaceId))
}
path <- paste0("/applications/", application$application_id, "/deploy")
json <- list()
if (length(bundleId) > 0 && nzchar(bundleId))
json$bundle <- as.numeric(bundleId)
else
json$rebuild <- FALSE
POST_JSON(service, authInfo, path, json)
},
terminateApplication = function(applicationId) {
path <- paste0("/applications/", applicationId, "/terminate")
POST(service, authInfo, path)
},
purgeApplication = function(applicationId) {
path <- paste0("/applications/", applicationId, "/purge")
POST(service, authInfo, path)
},
inviteApplicationUser = function(applicationId, email,
invite_email = NULL, invite_email_message = NULL) {
path <- paste0("/applications/", applicationId, "/authorization/users")
json <- list()
json$email <- email
if (!is.null(invite_email))
json$invite_email <- invite_email
if (!is.null(invite_email_message))
json$invite_email_message <- invite_email_message
POST_JSON(service, authInfo, path, json)
},
addApplicationUser = function(applicationId, userId) {
path <- paste0("/applications/", applicationId, "/authorization/users/",
userId)
PUT(service, authInfo, path, NULL)
},
removeApplicationUser = function(applicationId, userId) {
path <- paste0("/applications/", applicationId, "/authorization/users/",
userId)
DELETE(service, authInfo, path)
},
listApplicationAuthorization = function(applicationId) {
path <- paste0("/applications/", applicationId, "/authorization")
listRequest(service, authInfo, path, NULL, "authorization")
},
listApplicationUsers = function(applicationId) {
path <- paste0("/applications/", applicationId, "/authorization/users")
listRequest(service, authInfo, path, NULL, "users")
},
listApplicationGroups = function(applicationId) {
path <- paste0("/applications/", applicationId, "/authorization/groups")
listRequest(service, authInfo, path, NULL, "groups")
},
listApplicationInvitations = function(applicationId) {
path <- "/invitations/"
query <- paste(filterQuery("app_id", applicationId), collapse = "&")
listRequest(service, authInfo, path, query, "invitations")
},
listTasks = function(accountId, filters = NULL) {
if (is.null(filters)) {
filters <- vector()
}
path <- "/tasks/"
filters <- c(filterQuery("account_id", accountId), filters)
query <- paste(filters, collapse = "&")
listRequest(service, authInfo, path, query, "tasks", max = 100)
},
getTaskInfo = function(taskId) {
path <- paste0("/tasks/", taskId)
GET(service, authInfo, path)
},
getTaskLogs = function(taskId) {
path <- paste0("/tasks/", taskId, "/logs/")
GET(service, authInfo, path)
},
waitForTask = function(taskId, quiet = FALSE) {
if (!quiet) {
cat("Waiting for task: ", taskId, "\n", sep = "")
}
path <- paste0("/tasks/", taskId)
lastStatus <- NULL
while (TRUE) {
# check status
status <- GET(service, authInfo, path)
# display status to the user if it changed
if (!identical(lastStatus, status$description)) {
if (!quiet)
cat(" ", status$status, ": ", status$description, "\n", sep = "")
lastStatus <- status$description
}
# are we finished? (note: this codepath is the only way to exit this function)
if (status$finished) {
if (identical(status$status, "success")) {
return(NULL)
} else {
# always show task log on error
cli::cat_rule("Begin Task Log", line = "#")
taskLog(taskId, authInfo$name, authInfo$server, output = "stderr")
cli::cat_rule("End Task Log", line = "#")
stop(status$error, call. = FALSE)
}
}
# wait for 1 second before polling again
Sys.sleep(1)
}
}
)
}
rsconnect/R/bundlePackage.R 0000644 0001762 0000144 00000010431 14513230050 015311 0 ustar ligges users bundlePackages <- function(bundleDir,
extraPackages = character(),
quiet = FALSE,
verbose = FALSE,
error_call = caller_env()) {
deps <- computePackageDependencies(
bundleDir,
extraPackages,
quiet = quiet,
verbose = verbose
)
if (nrow(deps) == 0) {
return(list())
}
checkBundlePackages(deps, call = error_call)
# Manifest packages used to generate packrat file on Connect
# https://github.com/rstudio/connect/blob/v2023.03.0/src/connect/manifest/convert.go#L261-L320
packages_list <- lapply(seq_len(nrow(deps)), function(i) {
out <- as.list(deps[i, , drop = FALSE])
out$description <- out$description[[1]]
out$Package <- NULL
out$Version <- NULL
out
})
names(packages_list) <- deps$Package
packages_list
}
usePackrat <- function() {
# Use RSCONNECT_PACKRAT when it has any value; fall-back to rsconnect.packrat when the environment
# variable is unset.
value <- Sys.getenv("RSCONNECT_PACKRAT", unset = NA)
if (is.na(value)) {
value <- getOption("rsconnect.packrat", default = FALSE)
}
return(truthy(value))
}
computePackageDependencies <- function(bundleDir,
extraPackages = character(),
quiet = FALSE,
verbose = FALSE) {
if (usePackrat()) {
taskStart(quiet, "Capturing R dependencies with packrat")
# Remove renv.lock so the packrat call to renv::dependencies does not report an implicit renv
# dependency. Mirrors rsconnect before 1.0.0, which did not include renv.lock in bundles.
# https://github.com/rstudio/rsconnect/blob/v0.8.29/R/bundle.R#L96
removeRenv(bundleDir)
deps <- snapshotPackratDependencies(bundleDir, extraPackages, verbose = verbose)
} else if (file.exists(renvLockFile(bundleDir))) {
# This ignores extraPackages; if you're using a lockfile it's your
# responsibility to install any other packages you need
taskStart(quiet, "Capturing R dependencies from renv.lock")
deps <- parseRenvDependencies(bundleDir)
# Once we've captured the deps, we can remove the renv directory
# from the bundle (retaining the renv.lock).
removeRenv(bundleDir, lockfile = FALSE)
} else {
taskStart(quiet, "Capturing R dependencies with renv")
# TODO: give user option to choose between implicit and explicit
deps <- snapshotRenvDependencies(bundleDir, extraPackages, verbose = verbose)
}
taskComplete(quiet, "Found {nrow(deps)} dependenc{?y/ies}")
deps
}
checkBundlePackages <- function(deps, call = caller_env()) {
unknown_source <- is.na(deps$Source)
if (any(unknown_source)) {
pkgs <- deps$Package[unknown_source]
cli::cli_abort(
c(
"All packages must be installed from a reproducible location.",
x = "Can't re-install packages installed from source: {.pkg {pkgs}}.",
i = "See {.fun rsconnect::appDependencies} for more details."
),
call = call
)
}
}
manifestPackageColumns <- function(df) {
# Fields defined in https://bit.ly/42CbD4P
# Most fields are retrieved from the complete embedded description.
# shinyapps.io needs GitHub fields for backward compatibility
github_cols <- grep("^Github", names(df), perl = TRUE, value = TRUE)
intersect(
c("Package", "Version", "Source", "Repository", github_cols),
names(df)
)
}
availablePackages <- function(repos) {
# read available.packages filters (allow user to override if necessary;
# this is primarily to allow debugging)
#
# note that we explicitly exclude the "R_version" filter as we want to ensure
# that packages which require newer versions of R than the one currently
# in use can still be marked as available on CRAN -- for example, currently
# the package "foreign" requires "R (>= 4.0.0)" but older versions of R
# can still successfully install older versions from the CRAN archive
filters <- c(
getOption("rsconnect.available_packages_filters", default = c()),
"duplicates"
)
available.packages(
repos = repos,
type = "source",
filters = filters
)
}
package_record <- function(name, lib_dir = NULL) {
record <- packageDescription(name, lib.loc = lib_dir, encoding = "UTF-8")
unclass(record)
}
rsconnect/R/import-standalone-types-check.R 0000644 0001762 0000144 00000024754 14513230050 020456 0 ustar ligges users # Standalone file: do not edit by hand
# Source:
# ----------------------------------------------------------------------
#
# ---
# repo: r-lib/rlang
# file: standalone-types-check.R
# last-updated: 2022-10-07
# license: https://unlicense.org
# dependencies: standalone-obj-type.R
# ---
#
# ## Changelog
#
# 2022-10-07:
# - `check_number_whole()` and `_decimal()` no longer treat
# non-numeric types such as factors or dates as numbers. Numeric
# types are detected with `is.numeric()`.
#
# 2022-10-04:
# - Added `check_name()` that forbids the empty string.
# `check_string()` allows the empty string by default.
#
# 2022-09-28:
# - Removed `what` arguments.
# - Added `allow_na` and `allow_null` arguments.
# - Added `allow_decimal` and `allow_infinite` arguments.
# - Improved errors with absent arguments.
#
#
# 2022-09-16:
# - Unprefixed usage of rlang functions with `rlang::` to
# avoid onLoad issues when called from rlang (#1482).
#
# 2022-08-11:
# - Added changelog.
#
# nocov start
# Scalars -----------------------------------------------------------------
check_bool <- function(x,
...,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_bool(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
if (allow_na && identical(x, NA)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
c("`TRUE`", "`FALSE`"),
...,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_string <- function(x,
...,
allow_empty = TRUE,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
is_string <- .rlang_check_is_string(
x,
allow_empty = allow_empty,
allow_na = allow_na,
allow_null = allow_null
)
if (is_string) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a single string",
...,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
.rlang_check_is_string <- function(x,
allow_empty,
allow_na,
allow_null) {
if (is_string(x)) {
if (allow_empty || !is_string(x, "")) {
return(TRUE)
}
}
if (allow_null && is_null(x)) {
return(TRUE)
}
if (allow_na && (identical(x, NA) || identical(x, na_chr))) {
return(TRUE)
}
FALSE
}
check_name <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
is_string <- .rlang_check_is_string(
x,
allow_empty = FALSE,
allow_na = FALSE,
allow_null = allow_null
)
if (is_string) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a valid name",
...,
allow_na = FALSE,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_number_decimal <- function(x,
...,
min = -Inf,
max = Inf,
allow_infinite = TRUE,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
.rlang_types_check_number(
x,
...,
min = min,
max = max,
allow_decimal = TRUE,
allow_infinite = allow_infinite,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_number_whole <- function(x,
...,
min = -Inf,
max = Inf,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
.rlang_types_check_number(
x,
...,
min = min,
max = max,
allow_decimal = FALSE,
allow_infinite = FALSE,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
.rlang_types_check_number <- function(x,
...,
min = -Inf,
max = Inf,
allow_decimal = FALSE,
allow_infinite = FALSE,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (allow_decimal) {
what <- "a number"
} else {
what <- "a whole number"
}
.stop <- function(x, what, ...) stop_input_type(
x,
what,
...,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
if (!missing(x)) {
is_number <- is_number(
x,
allow_decimal = allow_decimal,
allow_infinite = allow_infinite
)
if (is_number) {
if (min > -Inf && max < Inf) {
what <- sprintf("a number between %s and %s", min, max)
} else {
what <- NULL
}
if (x < min) {
what <- what %||% sprintf("a number larger than %s", min)
.stop(x, what, ...)
}
if (x > max) {
what <- what %||% sprintf("a number smaller than %s", max)
.stop(x, what, ...)
}
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
if (allow_na && (identical(x, NA) ||
identical(x, na_dbl) ||
identical(x, na_int))) {
return(invisible(NULL))
}
}
.stop(x, what, ...)
}
is_number <- function(x,
allow_decimal = FALSE,
allow_infinite = FALSE) {
if (!typeof(x) %in% c("integer", "double")) {
return(FALSE)
}
if (!is.numeric(x)) {
return(FALSE)
}
if (length(x) != 1) {
return(FALSE)
}
if (is.na(x)) {
return(FALSE)
}
if (!allow_decimal && !is_integerish(x)) {
return(FALSE)
}
if (!allow_infinite && is.infinite(x)) {
return(FALSE)
}
TRUE
}
check_symbol <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_symbol(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a symbol",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_arg <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_symbol(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"an argument name",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_call <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_call(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a defused call",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_environment <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_environment(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"an environment",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_function <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_function(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a function",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_closure <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_closure(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"an R function",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_formula <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_formula(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a formula",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
# Vectors -----------------------------------------------------------------
check_character <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_character(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a character vector",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
# nocov end
rsconnect/R/utils-cli.R 0000644 0001762 0000144 00000003230 14513230050 014470 0 ustar ligges users # https://github.com/r-lib/cli/issues/228 ---------------------------------
simulate_user_input <- function(x, env = caller_env()) {
withr::local_options(
rlang_interactive = TRUE,
cli_prompt = as.character(x),
.local_envir = env
)
}
cli_menu <- function(header,
prompt,
choices,
not_interactive = choices,
quit = integer(),
.envir = caller_env(),
error_call = caller_env()) {
if (!is_interactive()) {
cli::cli_abort(
c(header, not_interactive),
.envir = .envir,
call = error_call
)
}
choices <- paste0(cli::style_bold(seq_along(choices)), ": ", choices)
cli::cli_inform(
c(header, prompt, choices),
.envir = .envir
)
repeat {
selected <- cli_readline("Selection: ")
if (selected %in% c("0", seq_along(choices))) {
break
}
cli::cli_inform(
"Type a number between 1 and {length(choices)}, or type 0 to exit."
)
}
selected <- as.integer(selected)
if (selected %in% c(0, quit)) {
if (is_testing()) {
cli::cli_abort("Quitting...", call = NULL)
} else {
cli::cli_alert_danger("Quitting...")
# simulate user pressing Ctrl + C
invokeRestart("abort", cnd)
}
}
selected
}
cli_readline <- function(prompt) {
testing <- getOption("cli_prompt", character())
if (length(testing) > 0) {
selected <- testing[[1]]
cli::cli_inform(paste0(prompt, selected))
options(cli_prompt = testing[-1])
selected
} else {
readline(prompt)
}
}
is_testing <- function() {
identical(Sys.getenv("TESTTHAT"), "true")
}
rsconnect/R/client-shinyapps.R 0000644 0001762 0000144 00000022422 14513230050 016061 0 ustar ligges users shinyAppsClient <- function(service, authInfo) {
list(
status = function() {
GET(service, authInfo, "/internal/status")
},
service = function() {
"shinyapps.io"
},
currentUser = function() {
GET(service, authInfo, "/users/current/")
},
accountsForUser = function(userId) {
path <- "/accounts/"
query <- ""
listRequest(service, authInfo, path, query, "accounts")
},
getAccountUsage = function(accountId, usageType = "hours", applicationId = NULL,
from = NULL, until = NULL, interval = NULL) {
path <- paste("/accounts/", accountId, "/usage/", usageType, "/", sep = "")
query <- list()
if (!is.null(applicationId))
query$application <- applicationId
if (!is.null(from))
query$from <- from
if (!is.null(until))
query$until <- until
if (!is.null(interval))
query$interval <- interval
GET(service, authInfo, path, queryString(query))
},
getBundle = function(bundleId) {
path <- paste("/bundles/", bundleId, sep = "")
GET(service, authInfo, path)
},
updateBundleStatus = function(bundleId, status) {
path <- paste("/bundles/", bundleId, "/status", sep = "")
json <- list()
json$status <- status
POST_JSON(service, authInfo, path, json)
},
createBundle = function(application, content_type, content_length, checksum) {
json <- list()
json$application <- application
json$content_type <- content_type
json$content_length <- content_length
json$checksum <- checksum
POST_JSON(service, authInfo, "/bundles", json)
},
listApplications = function(accountId, filters = list()) {
path <- "/applications/"
query <- paste(filterQuery(
c("account_id", "type", names(filters)),
c(accountId, "shiny", unname(filters))
), collapse = "&")
listRequest(service, authInfo, path, query, "applications")
},
getApplication = function(applicationId, deploymentRecordVersion) {
path <- paste("/applications/", applicationId, sep = "")
application <- GET(service, authInfo, path)
application$application_id <- application$id
application
},
getApplicationMetrics = function(applicationId, series, metrics, from = NULL, until = NULL, interval = NULL) {
path <- paste("/applications/", applicationId, "/metrics/", series, "/", sep = "")
query <- list()
m <- paste(lapply(metrics, function(x) { paste("metric", urlEncode(x), sep = "=") }), collapse = "&")
if (!is.null(from))
query$from <- from
if (!is.null(until))
query$until <- until
if (!is.null(interval))
query$interval <- interval
GET(service, authInfo, path, paste(m, queryString(query), sep = "&"))
},
getLogs = function(applicationId, entries = 50) {
path <- paste0("/applications/", applicationId, "/logs")
query <- paste0("count=", entries, "&tail=0")
GET(service, authInfo, path, query)
},
createApplication = function(name, title, template, accountId, appMode, contentCategory = NULL, spaceId = NULL) {
json <- list()
json$name <- name
# the title field is only used on connect
json$template <- template
json$account <- as.numeric(accountId)
application <- POST_JSON(service, authInfo, "/applications/", json)
list(
id = application$id,
application_id = application$id,
url = application$url
)
},
listApplicationProperties = function(applicationId) {
path <- paste("/applications/", applicationId, "/properties/", sep = "")
GET(service, authInfo, path)
},
setApplicationProperty = function(applicationId, propertyName,
propertyValue, force = FALSE) {
path <- paste("/applications/", applicationId, "/properties/",
propertyName, sep = "")
v <- list()
v$value <- propertyValue
query <- paste("force=", if (force) "1" else "0", sep = "")
PUT_JSON(service, authInfo, path, v, query)
},
unsetApplicationProperty = function(applicationId, propertyName,
force = FALSE) {
path <- paste("/applications/", applicationId, "/properties/",
propertyName, sep = "")
query <- paste("force=", if (force) "1" else "0", sep = "")
DELETE(service, authInfo, path, query)
},
uploadApplication = function(applicationId, bundlePath) {
path <- paste("/applications/", applicationId, "/upload", sep = "")
POST(
service,
authInfo,
path,
contentType = "application/x-gzip",
file = bundlePath
)
},
deployApplication = function(application, bundleId = NULL, spaceId = NULL) {
path <- paste("/applications/", application$id, "/deploy", sep = "")
json <- list()
if (length(bundleId) > 0 && nzchar(bundleId))
json$bundle <- as.numeric(bundleId)
else
json$rebuild <- FALSE
POST_JSON(service, authInfo, path, json)
},
terminateApplication = function(applicationId) {
path <- paste("/applications/", applicationId, "/terminate", sep = "")
POST(service, authInfo, path)
},
purgeApplication = function(applicationId) {
path <- paste("/applications/", applicationId, "/purge", sep = "")
POST(service, authInfo, path)
},
inviteApplicationUser = function(applicationId, email,
invite_email = NULL, invite_email_message = NULL) {
path <- paste("/applications/", applicationId, "/authorization/users",
sep = "")
json <- list()
json$email <- email
if (!is.null(invite_email))
json$invite_email <- invite_email
if (!is.null(invite_email_message))
json$invite_email_message <- invite_email_message
POST_JSON(service, authInfo, path, json)
},
addApplicationUser = function(applicationId, userId) {
path <- paste("/applications/", applicationId, "/authorization/users/",
userId, sep = "")
PUT(service, authInfo, path, NULL)
},
removeApplicationUser = function(applicationId, userId) {
path <- paste("/applications/", applicationId, "/authorization/users/",
userId, sep = "")
DELETE(service, authInfo, path, NULL)
},
listApplicationAuthorization = function(applicationId) {
path <- paste("/applications/", applicationId, "/authorization",
sep = "")
listRequest(service, authInfo, path, NULL, "authorization")
},
listApplicationUsers = function(applicationId) {
path <- paste("/applications/", applicationId, "/authorization/users",
sep = "")
listRequest(service, authInfo, path, NULL, "users")
},
listApplicationGroups = function(applicationId) {
path <- paste("/applications/", applicationId, "/authorization/groups",
sep = "")
listRequest(service, authInfo, path, NULL, "groups")
},
listApplicationInvitations = function(applicationId) {
path <- "/invitations/"
query <- paste(filterQuery("app_id", applicationId), collapse = "&")
listRequest(service, authInfo, path, query, "invitations")
},
resendApplicationInvitation = function(invitationId, regenerate = FALSE) {
path <- paste("/invitations/", invitationId, "/send", sep = "")
json <- list()
json$regenerate <- regenerate
POST_JSON(service, authInfo, path, json)
},
listTasks = function(accountId, filters = NULL) {
if (is.null(filters)) {
filters <- vector()
}
path <- "/tasks/"
filters <- c(filterQuery("account_id", accountId), filters)
query <- paste(filters, collapse = "&")
listRequest(service, authInfo, path, query, "tasks", max = 100)
},
getTaskInfo = function(taskId) {
path <- paste("/tasks/", taskId, sep = "")
GET(service, authInfo, path)
},
getTaskLogs = function(taskId) {
path <- paste("/tasks/", taskId, "/logs/", sep = "")
GET(service, authInfo, path)
},
waitForTask = function(taskId, quiet = FALSE) {
if (!quiet) {
cat("Waiting for task: ", taskId, "\n", sep = "")
}
path <- paste("/tasks/", taskId, sep = "")
lastStatus <- NULL
while (TRUE) {
# check status
status <- GET(service, authInfo, path)
# display status to the user if it changed
if (!identical(lastStatus, status$description)) {
if (!quiet)
cat(" ", status$status, ": ", status$description, "\n", sep = "")
lastStatus <- status$description
}
# are we finished? (note: this codepath is the only way to exit this function)
if (status$finished) {
if (identical(status$status, "success")) {
return(NULL)
} else {
# always show task log on error
cli::cat_rule("Begin Task Log", line = "#")
taskLog(taskId, authInfo$name, authInfo$server, output = "stderr")
cli::cat_rule("End Task Log", line = "#")
stop(status$error, call. = FALSE)
}
}
# wait for 1 second before polling again
Sys.sleep(1)
}
}
)
}
rsconnect/R/deployments.R 0000644 0001762 0000144 00000021670 14522164250 015146 0 ustar ligges users #' List Application Deployments
#'
#' List deployment records for a given application.
#' @param appPath The path to the content that was deployed, either a directory
#' or an individual document.
#' @param nameFilter Return only deployments matching the given name (optional)
#' @param accountFilter Return only deployments matching the given account
#' (optional)
#' @param serverFilter Return only deployments matching the given server
#' (optional)
#' @param excludeOrphaned If `TRUE` (the default), return only deployments
#' made by a currently registered account. Deployments made from accounts that
#' are no longer registered (via e.g.[removeAccount()]) will not be
#' returned.
#' @return
#' Returns a data frame with at least following columns:
#' \tabular{ll}{
#' `name` \tab Name of deployed application\cr
#' `account` \tab Account owning deployed application\cr
#' `bundleId` \tab Identifier of deployed application's bundle\cr
#' `url` \tab URL of deployed application\cr
#' `deploymentFile` \tab Name of configuration file\cr
#' }
#'
#' If additional metadata has been saved with the deployment record using the
#' `metadata` argument to [deployApp()], the frame will include
#' additional columns.
#'
#' @examples
#' \dontrun{
#'
#' # Return all deployments of the ~/r/myapp directory made with the 'abc'
#' # account
#' deployments("~/r/myapp", accountFilter="abc")
#' }
#' @seealso [applications()] to get a list of deployments from the
#' server, and [deployApp()] to create a new deployment.
#' @export
deployments <- function(appPath = ".",
nameFilter = NULL,
accountFilter = NULL,
serverFilter = NULL,
excludeOrphaned = TRUE) {
migrateDeploymentsConfig(appPath)
paths <- deploymentConfigFiles(appPath)
dcf <- lapply(paths, read.dcf)
dcf <- lapply(dcf, as.data.frame, stringsAsFactors = FALSE)
deployments <- rbind_fill(dcf, deploymentFields)
deployments$deploymentFile <- paths
# Apply filters
ok <- rep(TRUE, nrow(deployments))
if (!is.null(nameFilter)) {
ok <- ok & deployments$name == nameFilter
}
if (!is.null(accountFilter)) {
ok <- ok & deployments$account == accountFilter
}
if (!is.null(serverFilter)) {
ok <- ok & deployments$server == serverFilter
}
if (excludeOrphaned) {
activeAccounts <- accounts()
activeAccountServers <- paste0(activeAccounts$server, "@", activeAccounts$name)
accountServer <- paste0(deployments$server, "@", deployments$account)
okServer <- isRPubs(deployments$server) | accountServer %in% activeAccountServers
ok <- ok & okServer
}
deployments$envVars[is.na(deployments$envVars)] <- ""
if (is.character(deployments$envVars)) {
deployments$envVars <- strsplit(deployments$envVars, ", ")
}
deployments[ok, , drop = FALSE]
}
deploymentFields <- c(
"name", "title", "username", "account", "server", "hostUrl", "appId",
"bundleId", "url", "envVars", "version"
)
deploymentRecordVersion <- 1L
# Save a deployment record to disk using an incoming record (which may or may
# not correspond to an existing on-disk deployment record). Created by
# deploymentRecord() or by findDeploymentTarget(), and possibly loaded from
# disk.
saveDeployment <- function(recordDir,
deployment,
application,
bundleId = NULL,
hostUrl = serverInfo(deployment$server)$url,
metadata = list(),
addToHistory = TRUE) {
deployment <- deploymentRecord(
name = deployment$name,
title = deployment$title,
username = deployment$username,
account = deployment$account,
server = deployment$server,
envVars = deployment$envVars,
version = deployment$version,
hostUrl = hostUrl,
appId = application$id,
bundleId = bundleId,
url = application$url,
metadata = metadata
)
path <- deploymentConfigFile(recordDir, deployment$name, deployment$account, deployment$server)
writeDeploymentRecord(deployment, path)
# also save to global history
if (addToHistory) {
addToDeploymentHistory(recordDir, deployment)
}
invisible(path)
}
deploymentRecord <- function(name,
title,
username,
account,
server,
envVars = NULL,
hostUrl = NULL,
appId = NULL,
bundleId = NULL,
url = NULL,
version = deploymentRecordVersion,
metadata = list()) {
check_character(envVars, allow_null = TRUE)
standard <- list(
name = name,
title = title %||% "",
username = username,
account = account,
server = server,
envVars = if (length(envVars) > 0) paste0(envVars, collapse = ", ") else NA,
hostUrl = hostUrl %||% "",
appId = appId %||% "",
bundleId = bundleId %||% "",
url = url %||% "",
version = version
)
# convert any multi-value metadata entries into comma-separated values
# this prevents write.dcf from writing multiple records into one file.
metadata <- lapply(metadata, function(v) paste0(v, collapse = ", "))
c(standard, metadata)
}
writeDeploymentRecord <- function(record, filePath) {
# use a long width so URLs don't line-wrap
write.dcf(record, filePath, width = 4096)
}
# Workbench uses to show a list of recently deployed content on user dashboard
addToDeploymentHistory <- function(appPath, deploymentRecord) {
# add the appPath to the deploymentRecord
deploymentRecord$appPath <- appPath
# write new history file
newHistory <- deploymentHistoryPath(new = TRUE)
writeDeploymentRecord(deploymentRecord, newHistory)
history <- deploymentHistoryPath()
# append existing history to new history
if (file.exists(history)) {
cat("\n", file = newHistory, append = TRUE)
file.append(newHistory, history)
}
# overwrite with new history
file.rename(newHistory, history)
invisible()
}
#' Forget Application Deployment
#'
#' Forgets about an application deployment. This is useful if the application
#' has been deleted on the server, or the local deployment information needs to
#' be reset.
#'
#' @param appPath The path to the content that was deployed, either a directory
#' or an individual document.
#' @param name The name of the content that was deployed (optional)
#' @param account The name of the account to which the content was deployed
#' (optional)
#' @param server The name of the server to which the content was deployed
#' (optional)
#' @param dryRun Set to TRUE to preview the files/directories to be removed
#' instead of actually removing them. Defaults to FALSE.
#' @param force Set to TRUE to remove files and directories without prompting.
#' Defaults to FALSE in interactive sessions.
#' @return NULL, invisibly.
#'
#' @details This method removes from disk the file containing deployment
#' metadata. If "name", "account", and "server" are all NULL, then all of the
#' deployments for the application are forgotten; otherwise, only the
#' specified deployment is forgotten.
#'
#' @export
forgetDeployment <- function(appPath = getwd(), name = NULL,
account = NULL, server = NULL,
dryRun = FALSE, force = !interactive()) {
if (is.null(name) && is.null(account) && is.null(server)) {
dcfDir <- deploymentConfigDir(appPath)
if (dryRun)
message("Would remove the directory ", dcfDir)
else if (file.exists(dcfDir)) {
if (!force) {
prompt <- paste("Forget all deployment records for ", appPath, "? [Y/n] ", sep = "")
input <- readline(prompt)
if (nzchar(input) && !identical(input, "y") && !identical(input, "Y"))
stop("No deployment records removed.", call. = FALSE)
}
unlink(dcfDir, recursive = TRUE)
} else {
message("No deployments found for the application at ", appPath)
}
} else {
if (is.null(name) || is.null(account) || is.null(server)) {
stop("Invalid argument. ",
"Supply the name, account, and server of the deployment record to delete. ",
"Supply NULL for all three to delete all deployment records.")
}
dcf <- deploymentConfigFile(appPath, name, account, server)
if (dryRun)
message("Would remove the file ", dcf)
else if (file.exists(dcf)) {
if (!force) {
prompt <- paste("Forget deployment of ", appPath, " to '", name, "' on ",
server, "? [Y/n] ", sep = "")
input <- readline(prompt)
if (nzchar(input) && !identical(input, "y") && !identical(input, "Y"))
stop("Cancelled. No deployment records removed.", call. = FALSE)
}
unlink(dcf)
} else {
message("No deployment of ", appPath, " to '", name, "' on ", server,
" found.")
}
}
invisible(NULL)
}
rsconnect/R/config.R 0000644 0001762 0000144 00000007573 14513230050 014046 0 ustar ligges users #' rsconnect Configuration Directory
#'
#' Forms the path to a location on disk where user-level configuration data for
#' the package is stored.
#'
#' @param subDir An optional subdirectory to be included as the last element of
#' the path.
#'
#' @return The path to the configuration directory.
#'
#' @keywords internal
rsconnectConfigDir <- function(subDir = NULL) {
configDir <- applicationConfigDir()
# If the configuration directory doesn't exist, see if there's an old one to
# migrate
if (!dirExists(configDir)) {
migrateConfig(configDir)
}
# Form the target and append the optional subdirectory if given
target <- configDir
if (!is.null(subDir)) {
target <- file.path(target, subDir)
}
dirCreate(target)
}
#' Application Configuration Directory
#'
#' Returns the root path used to store per user configuration data. Does not
#' check old locations or create the path; use \code{rsconnectConfigDir} for
#' most cases.
#'
#' @return A string containing the path of the configuration folder.
#'
#' @keywords internal
applicationConfigDir <- function() {
if (exists("R_user_dir", envir = asNamespace("tools"))) {
# In newer versions of R (>=4.0), we can ask R itself where configuration should be stored.
# Load from the namespace to avoid check warnings with old R.
f <- get("R_user_dir", envir = asNamespace("tools"))
f("rsconnect", "config")
} else {
# In older versions of R, use an implementation derived from R_user_dir
home <- Sys.getenv("HOME", unset = normalizePath("~"))
path <-
if (nzchar(p <- Sys.getenv("R_USER_CONFIG_DIR")))
p
else if (nzchar(p <- Sys.getenv("XDG_CONFIG_HOME")))
p
else if (.Platform$OS.type == "windows")
file.path(Sys.getenv("APPDATA"), "R", "config")
else if (Sys.info()["sysname"] == "Darwin")
file.path(home, "Library", "Preferences", "org.R-project.R")
else
file.path(home, ".config")
file.path(path, "R", "rsconnect")
}
}
# server ------------------------------------------------------------------
serverConfigDir <- function() {
rsconnectConfigDir("servers")
}
serverConfigFile <- function(name) {
normalizePath(
file.path(serverConfigDir(), paste(name, ".dcf", sep = ""))
)
}
serverConfigFiles <- function() {
list.files(serverConfigDir(), pattern = glob2rx("*.dcf"), full.names = TRUE)
}
# account -----------------------------------------------------------------
accountConfigDir <- function() {
rsconnectConfigDir("accounts")
}
accountConfigFile <- function(name, server) {
normalizePath(
file.path(accountConfigDir(), server, paste(name, ".dcf", sep = ""))
)
}
accountConfigFiles <- function(server = NULL) {
path <- accountConfigDir()
if (!is.null(server)) {
path <- file.path(path, server)
}
list.files(path, pattern = glob2rx("*.dcf"), recursive = TRUE, full.names = TRUE)
}
# deployments -------------------------------------------------------------
deploymentHistoryPath <- function(new = FALSE) {
file.path(
rsconnectConfigDir("deployments"),
paste0("history", if (new) ".new", ".dcf")
)
}
# given a path, return the directory under which rsconnect package state is
# stored
deploymentConfigDir <- function(recordPath) {
if (isDocumentPath(recordPath)) {
file.path(dirname(recordPath), "rsconnect", "documents", basename(recordPath))
} else {
file.path(recordPath, "rsconnect")
}
}
deploymentConfigFile <- function(recordPath, name, account, server) {
accountDir <- file.path(deploymentConfigDir(recordPath), server, account)
dirCreate(accountDir)
file.path(accountDir, paste0(name, ".dcf"))
}
deploymentConfigFiles <- function(recordPath) {
dir <- deploymentConfigDir(recordPath)
list.files(dir, glob2rx("*.dcf"), recursive = TRUE, full.names = TRUE)
}
# Does the path point to an individual piece of content?
isDocumentPath <- function(path) {
tools::file_ext(path) != ""
}
rsconnect/R/rsconnect-package.R 0000644 0001762 0000144 00000000612 14513230050 016153 0 ustar ligges users #' @keywords internal
"_PACKAGE"
#' Using Packages with rsconnect
#'
#' See ?[appDependencies()]
#' @keywords internal
#' @name rsconnectPackages
NULL
#' HTTP Proxy Configuration
#'
#' Please see `vignette("custom-http")`.
#'
#' @keywords internal
#' @name rsconnectProxies
NULL
## usethis namespace: start
#' @import rlang
#' @importFrom lifecycle deprecated
## usethis namespace: end
NULL
rsconnect/R/http-libcurl.R 0000644 0001762 0000144 00000010060 14513230050 015173 0 ustar ligges users httpLibCurl <- function(protocol,
host,
port,
method,
path,
headers,
contentType = NULL,
contentFile = NULL,
certificate = NULL,
timeout = NULL) {
request <- list(
protocol = protocol,
host = host,
port = port,
method = method,
path = path
)
handle <- createCurlHandle(
method = method,
timeout = timeout,
certificate = certificate
)
if (!is.null(contentFile)) {
if (is.null(contentType)) {
stop("You must specify a contentType for the specified file")
}
fileLength <- file.info(contentFile)$size
headers$`Content-Type` <- contentType
headers$`Content-Length` <- as.character(fileLength)
# open a connection to read the file, and ensure it's closed when we're done
contentCon <- file(contentFile, "rb")
defer(if (!is.null(contentCon)) close(contentCon))
progress <- is_interactive() && fileLength >= 10 * 1024^2
curl::handle_setopt(
handle,
noprogress = !progress,
upload = TRUE,
infilesize_large = fileLength,
readfunction = function(nbytes, ...) {
if (is.null(contentCon)) {
return(raw())
}
bin <- readBin(contentCon, "raw", nbytes)
if (length(bin) < nbytes) {
close(contentCon)
contentCon <<- NULL
}
bin
}
)
}
headers <- appendCookieHeaders(request, headers)
curl::handle_setheaders(handle, .list = headers)
# make the request
url <- buildHttpUrl(request)
start <- proc.time()
response <- curl::curl_fetch_memory(url, handle = handle)
time <- proc.time() - start
httpTrace(method, path, time)
# Process headers
headers <- curl::parse_headers_list(rawToChar(response$headers))
# Parse cookies from header; bear in mind that there may be multiple headers
cookieHeaders <- headers[names(headers) == "set-cookie"]
storeCookies(request, cookieHeaders)
# presume a plain text response unless specified otherwise
contentType <- headers[["content-type"]] %||% "text/plain"
contentValue <- rawToChar(response$content)
# emit JSON trace if requested
jsonTracingEnabled <- httpTraceJson() && contentType == "application/json"
if (jsonTracingEnabled) {
if (!is.null(contentFile)) {
cat(paste0("<< ", readLines(contentFile, warn = FALSE), "\n", collapse = ""))
}
lines <- strsplit(contentValue, "\n")[[1]]
cat(paste0(">> ", lines, "\n", collapse = ""))
}
list(
req = request,
status = response$status_code,
location = headers$location,
contentType = contentType,
content = contentValue
)
}
createCurlHandle <- function(method,
timeout = NULL,
certificate = NULL) {
# create curl handle
handle <- curl::new_handle()
# overlay user-supplied options
userOptions <- getOption("rsconnect.libcurl.options")
if (is.list(userOptions)) {
curl::handle_setopt(handle, .list = userOptions)
}
curl::handle_setopt(handle, customrequest = method)
curl::handle_setopt(handle, useragent = userAgent())
if (isTRUE(getOption("rsconnect.check.certificate", TRUE))) {
curl::handle_setopt(handle, ssl_verifypeer = TRUE)
# apply certificate information if present
if (!is.null(certificate)) {
curl::handle_setopt(handle, cainfo = certificate)
}
} else {
# don't verify peer (less secure but tolerant to self-signed cert issues)
curl::handle_setopt(handle, ssl_verifypeer = FALSE)
}
# use timeout if supplied
if (!is.null(timeout)) {
curl::handle_setopt(handle, timeout = timeout)
}
# verbose if requested
if (httpVerbose()) {
curl::handle_setopt(handle, verbose = TRUE)
}
# suppress curl's automatically handling of redirects, since we have to
# handle ourselves in httpRequest()/httpRequestWithBody() due to our
# specialised auth needs
curl::handle_setopt(handle, followlocation = FALSE)
handle
}
rsconnect/R/http-curl.R 0000644 0001762 0000144 00000006362 14513230050 014516 0 ustar ligges users # HTTP transport using the curl command-line utility. Useful on systems that have a working curl but
# not necessarily a working curl library, such as Windows 10.
httpCurl <- function(protocol,
host,
port,
method,
path,
headers,
contentType = NULL,
contentFile = NULL,
certificate = NULL,
timeout = NULL) {
if (!is.null(contentFile) && is.null(contentType))
stop("You must specify a contentType for the specified file")
if (!is.null(contentFile))
fileLength <- file.info(contentFile)$size
headers <- appendCookieHeaders(
list(protocol = protocol, host = host, port = port, path = path), headers)
extraHeaders <- character()
for (header in names(headers))
{
if (!identical(header, "Content-Type") && !identical(header, "Content-Length")) {
extraHeaders <- paste(extraHeaders, "--header")
extraHeaders <- paste(extraHeaders,
paste('"', header, ": ", headers[[header]], '"', sep = ""))
}
}
outputFile <- tempfile()
command <- paste("curl",
"-i",
"-X",
method)
if (httpVerbose())
command <- paste(command, "-v")
if (!is.null(timeout))
command <- paste(command, "--connect-timeout", timeout)
if (!is.null(contentFile)) {
command <- paste(command,
"-T",
shQuote(contentFile),
"--header", paste('"', "Content-Type: ", contentType, '"', sep = ""),
"--header", paste('"', "Content-Length: ", fileLength, '"', sep = ""))
}
# add prefix to port if necessary
if (nzchar(port))
port <- paste(":", port, sep = "")
if (!isTRUE(getOption("rsconnect.check.certificate", TRUE))) {
# suppressed certificate check
command <- paste(command, "--insecure")
} else if (!is.null(certificate)) {
# cert check not suppressed and we have a supplied cert
command <- paste(command,
"--cacert", shQuote(certificate))
}
command <- paste(command,
extraHeaders,
"--header", "Expect:",
"--user-agent", userAgent(),
"--silent",
"--show-error",
"-o", shQuote(outputFile),
paste('"', protocol, "://", host, port, path, '"', sep = ""))
result <- NULL
time <- system.time(gcFirst = FALSE, {
result <- system(command)
})
httpTrace(method, path, time)
# emit JSON trace if requested
if (!is.null(contentFile) && httpTraceJson() &&
identical(contentType, "application/json"))
{
fileLength <- file.info(contentFile)$size
fileContents <- readBin(contentFile, what = "raw", n = fileLength)
cat(paste0("<< ", rawToChar(fileContents), "\n"))
}
if (result == 0) {
fileConn <- file(outputFile, "rb")
defer(close(fileConn))
readHttpResponse(list(
protocol = protocol,
host = host,
port = port,
method = method,
path = path),
fileConn)
} else {
stop(paste("Curl request failed (curl error", result, "occurred)"))
}
}
rsconnect/R/http-internal.R 0000644 0001762 0000144 00000006210 14513230050 015355 0 ustar ligges users # Internal sockets HTTP transport. Not recommended since it does not support HTTPS, but useful as a
# last resort if other methods don't work since it can piggyback on IE proxy settings via R's own
# internet configuration.
httpInternal <- function(protocol,
host,
port,
method,
path,
headers,
contentType = NULL,
contentFile = NULL,
certificate = NULL,
timeout = NULL) {
if (!is.null(contentFile) && is.null(contentType))
stop("You must specify a contentType for the specified file")
# default port to 80 if necessary
if (!nzchar(port))
port <- "80"
# read file in binary mode
if (!is.null(contentFile)) {
fileLength <- file.info(contentFile)$size
fileContents <- readBin(contentFile, what = "raw", n = fileLength)
}
# build http request
request <- NULL
request <- c(request, paste(method, " ", path, " HTTP/1.1\r\n", sep = ""))
request <- c(request, "User-Agent: ", userAgent(), "\r\n")
request <- c(request, "Host: ", host, "\r\n", sep = "")
request <- c(request, "Accept: */*\r\n")
if (!is.null(contentFile)) {
request <- c(request, paste("Content-Type: ",
contentType,
"\r\n",
sep = ""))
request <- c(request, paste("Content-Length: ",
fileLength,
"\r\n",
sep = ""))
}
headers <- appendCookieHeaders(
list(protocol = protocol, host = host, port = port, path = path), headers)
for (name in names(headers))
{
request <- c(request,
paste(name, ": ", headers[[name]], "\r\n", sep = ""))
}
request <- c(request, "\r\n")
# output request if in verbose mode
if (httpVerbose())
cat(request)
# use timeout if supplied, default timeout if not (matches parameter behavior
# for socketConnection)
timeout <- if (is.null(timeout)) getOption("timeout") else timeout
# open socket connection
time <- system.time(gcFirst = FALSE, {
conn <- socketConnection(host = host,
port = as.integer(port),
open = "w+b",
blocking = TRUE,
timeout = timeout)
defer(close(conn))
# write the request header and file payload
writeBin(charToRaw(paste(request, collapse = "")), conn, size = 1)
if (!is.null(contentFile)) {
writeBin(fileContents, conn, size = 1)
}
# read the response
response <- readHttpResponse(list(
protocol = protocol,
host = host,
port = port,
method = method,
path = path),
conn)
})
httpTrace(method, path, time)
# print if in verbose mode
if (httpVerbose())
print(response)
# output JSON if requested
if (httpTraceJson() && identical(contentType, "application/json"))
cat(paste0("<< ", rawToChar(fileContents), "\n"))
# return it
response
}
rsconnect/R/restartApp.R 0000644 0001762 0000144 00000002302 14513230050 014707 0 ustar ligges users #' Restart an Application
#'
#' Restart an application currently running on a remote server.
#'
#' @param appName Name of application to restart
#' @param account Account name. If a single account is registered on the system
#' then this parameter can be omitted.
#' @param server Server name. Required only if you use the same account name on
#' multiple servers (see [servers()])
#' @param quiet Request that no status information be printed to the console
#' during the operation.
#' @examples
#' \dontrun{
#'
#' # restart an application
#' restartApp("myapp")
#' }
#' @seealso [applications()], [deployApp()], and
#' [terminateApp()]
#' @note This function works only for ShinyApps servers.
#' @export
restartApp <- function(appName, account = NULL, server = NULL, quiet = FALSE) {
accountDetails <- accountInfo(account, server)
checkShinyappsServer(accountDetails$server)
# define deploy task
taskDef <- list()
taskDef$beginStatus <- "Restarting application"
taskDef$endStatus <- "Application successfully restarted"
taskDef$action <- function(client, application) {
client$deployApplication(application)
}
# perform it
applicationTask(taskDef, appName, accountDetails, quiet)
}
rsconnect/R/usage.R 0000644 0001762 0000144 00000012126 14513230050 013673 0 ustar ligges users #' Show Application Usage
#'
#' Show application usage of a currently deployed application
#' @param appName Name of application
#' @param appDir Directory containing application. Defaults to
#' current working directory.
#' @inheritParams deployApp
#' @param usageType Use metric to retreive (for example: "hours")
#' @param from Date range starting timestamp (Unix timestamp or relative time
#' delta such as "2d" or "3w").
#' @param until Date range ending timestamp (Unix timestamp or relative time
#' delta such as "2d" or "3w").
#' @param interval Summarization interval. Data points at intervals less then this
#' will be grouped. (Relative time delta e.g. "120s" or "1h" or "30d").
#' @note This function only works for ShinyApps servers.
#' @export
showUsage <- function(appDir = getwd(), appName = NULL, account = NULL, server = NULL,
usageType = "hours", from = NULL, until = NULL, interval = NULL) {
accountDetails <- accountInfo(account, server)
checkShinyappsServer(accountDetails$server)
api <- clientForAccount(accountDetails)
# resolve application
if (is.null(appName))
appName <- basename(appDir)
application <- resolveApplication(accountDetails, appName)
# get application usage
data <- api$getAccountUsage(accountDetails$accountId,
usageType,
application$id,
from,
until,
interval)
if (length(data$points) < 1) {
stop("No data.", call. = FALSE)
}
# get data points
points <- data$points[[1]]
points <- lapply(points, function(X) {
X[[1]] <- X[[1]] / 1000 # convert from milliseconds to seconds
X
})
# convert to data frame
df <- data.frame(matrix(unlist(points), nrow = length(points), byrow = TRUE), stringsAsFactors = FALSE)
colnames(df) <- c("timestamp", usageType)
return(df)
}
#' Show Application Metrics
#'
#' Show application metrics of a currently deployed application.
#' This function only works for ShinyApps servers.
#'
#' @param metricSeries Metric series to query. Refer to the
#' [shinyapps.io documentation]()
#' for available series.
#' @param metricNames Metric names in the series to query. Refer to the
#' [shinyapps.io documentation]()
#' for available metrics.
#' @inheritParams deployApp
#' @param from Date range starting timestamp (Unix timestamp or relative time
#' delta such as "2d" or "3w").
#' @param until Date range ending timestamp (Unix timestamp or relative time
#' delta such as "2d" or "3w").
#' @param interval Summarization interval. Data points at intervals less then this
#' will be grouped. (Relative time delta e.g. "120s" or "1h" or "30d").
#' @export
showMetrics <- function(metricSeries,
metricNames,
appDir = getwd(),
appName = NULL,
account = NULL,
server = "shinyapps.io",
from = NULL,
until = NULL,
interval = NULL) {
accountDetails <- accountInfo(account, server)
api <- clientForAccount(accountDetails)
# resolve application
if (is.null(appName))
appName <- basename(appDir)
application <- resolveApplication(accountDetails, appName)
# get application usage
data <- api$getApplicationMetrics(application$id,
metricSeries,
metricNames,
from,
until,
interval)
if (length(data$points) < 1) {
stop("No data.", call. = FALSE)
}
points <- lapply(data$points, as.data.frame, stringsAsFactors = FALSE)
points <- do.call(rbind, points)
points$time <- .POSIXct(points$time / 1000)
points
}
#' Show Account Usage
#'
#' Show account usage
#' @inheritParams deployApp
#' @param usageType Use metric to retreive (for example: "hours")
#' @param from Date range starting timestamp (Unix timestamp or relative time
#' delta such as "2d" or "3w").
#' @param until Date range ending timestamp (Unix timestamp or relative time
#' delta such as "2d" or "3w").
#' @param interval Summarization interval. Data points at intervals less then this
#' will be grouped. (Number of seconds or relative time delta e.g. "1h").
#' @note This function only works for ShinyApps servers.
#' @export
accountUsage <- function(account = NULL, server = NULL, usageType = "hours",
from = NULL, until = NULL, interval = NULL) {
accountDetails <- accountInfo(account, server)
checkShinyappsServer(accountDetails$server)
api <- clientForAccount(accountDetails)
# get application usage
data <- api$getAccountUsage(accountDetails$accountId,
usageType,
NULL,
from,
until,
interval)
}
rsconnect/R/appMetadata.R 0000644 0001762 0000144 00000022070 14513230050 015007 0 ustar ligges users appMetadata <- function(appDir,
appFiles,
appPrimaryDoc = NULL,
quarto = NA,
appMode = NULL,
contentCategory = NULL,
isShinyappsServer = FALSE,
metadata = list()) {
checkAppLayout(appDir, appPrimaryDoc)
if (is_string(quarto)) {
lifecycle::deprecate_warn(
when = "1.0.0",
what = "deployApp(quarto = 'can no longer be a path')",
with = I("quarto = `TRUE` instead")
)
quarto <- TRUE
} else {
check_bool(quarto, allow_na = TRUE)
}
# If quarto package/IDE has supplied metadata, always use quarto
# https://github.com/quarto-dev/quarto-r/blob/08caf0f42504e7/R/publish.R#L117-L121
# https://github.com/rstudio/rstudio/blob/3d45a20307f650/src/cpp/session/modules/SessionRSConnect.cpp#L81-L123
if (hasQuartoMetadata(metadata)) {
quarto <- TRUE
}
if (is.null(appMode)) {
# Generally we want to infer appPrimaryDoc from appMode, but there's one
# special case
if (!is.null(appPrimaryDoc) &&
tolower(tools::file_ext(appPrimaryDoc)) == "r") {
appMode <- "shiny"
} else {
# Inference only uses top-level files
rootFiles <- appFiles[dirname(appFiles) == "."]
appMode <- inferAppMode(
file.path(appDir, rootFiles),
usesQuarto = quarto,
isShinyappsServer = isShinyappsServer
)
}
}
appPrimaryDoc <- inferAppPrimaryDoc(
appPrimaryDoc = appPrimaryDoc,
appFiles = appFiles,
appMode = appMode
)
hasParameters <- appHasParameters(
appDir = appDir,
appPrimaryDoc = appPrimaryDoc,
appMode = appMode,
contentCategory = contentCategory
)
documentsHavePython <- detectPythonInDocuments(
appDir = appDir,
files = appFiles
)
if (appIsQuartoDocument(appMode)) {
quartoInfo <- inferQuartoInfo(
metadata = metadata,
appDir = appDir,
appPrimaryDoc = appPrimaryDoc
)
} else {
quartoInfo <- NULL
}
list(
appMode = appMode,
appPrimaryDoc = appPrimaryDoc,
hasParameters = hasParameters,
contentCategory = contentCategory,
documentsHavePython = documentsHavePython,
quartoInfo = quartoInfo
)
}
checkAppLayout <- function(appDir, appPrimaryDoc = NULL) {
appFilesBase <- tolower(list.files(appDir))
primaryIsRScript <- identical(tolower(tools::file_ext(appPrimaryDoc)), "r")
# check for single-file app collision
if (primaryIsRScript && "app.r" %in% appFilesBase) {
cli::cli_abort(
"Project must not contain both {.file app.R} and a single-file Shiny app."
)
}
# all other layouts are allowed; the server determines (with the required packages) if the content
# can be run/served.
}
# infer the mode of the application from files in the root dir
inferAppMode <- function(absoluteRootFiles,
usesQuarto = NA,
isShinyappsServer = FALSE) {
matchingNames <- function(paths, pattern) {
idx <- grepl(pattern, basename(paths), ignore.case = TRUE, perl = TRUE)
paths[idx]
}
# plumber API
plumberFiles <- matchingNames(absoluteRootFiles, "^(plumber|entrypoint).r$")
if (length(plumberFiles) > 0) {
return("api")
}
# Shiny application using single-file app.R style.
appR <- matchingNames(absoluteRootFiles, "^app.r$")
if (length(appR) > 0) {
return("shiny")
}
rmdFiles <- matchingNames(absoluteRootFiles, "\\.rmd$")
qmdFiles <- matchingNames(absoluteRootFiles, "\\.qmd$")
if (is.na(usesQuarto)) {
# Can't use _quarto.yml alone because it causes deployment failures for
# static content: https://github.com/rstudio/rstudio/issues/11444
quartoYml <- matchingNames(absoluteRootFiles, "^_quarto.y(a)?ml$")
usesQuarto <- length(qmdFiles) > 0 ||
(length(quartoYml) > 0 && length(rmdFiles > 0))
}
# Documents with "server: shiny" in their YAML front matter need shiny too
hasShinyRmd <- any(sapply(rmdFiles, isShinyRmd))
hasShinyQmd <- any(sapply(qmdFiles, isShinyRmd))
if (hasShinyQmd) {
return("quarto-shiny")
} else if (hasShinyRmd) {
if (usesQuarto) {
return("quarto-shiny")
} else {
return("rmd-shiny")
}
}
# Shiny application using server.R; checked later than Rmd with shiny runtime
# because server.R may contain the server code paired with a ShinyRmd and needs
# to be run by rmarkdown::run (rmd-shiny).
serverR <- matchingNames(absoluteRootFiles, "^server.r$")
if (length(serverR) > 0) {
return("shiny")
}
# Any non-Shiny R Markdown or Quarto documents are rendered content and get
# rmd-static or quarto-static.
if (length(rmdFiles) > 0 || length(qmdFiles) > 0) {
if (usesQuarto) {
return("quarto-static")
} else {
# For shinyapps.io, treat "rmd-static" app mode as "rmd-shiny" so that
# it can be served from a shiny process in Connect
if (isShinyappsServer) {
return("rmd-shiny")
}
return("rmd-static")
}
}
# no renderable content
"static"
}
isShinyRmd <- function(filename) {
yaml <- yamlFromRmd(filename)
if (is.null(yaml)) {
return(FALSE)
}
is_shiny_prerendered(yaml$runtime, yaml$server)
}
yamlFromRmd <- function(filename) {
lines <- readLines(filename, warn = FALSE, encoding = "UTF-8")
delim <- grep("^(---|\\.\\.\\.)\\s*$", lines)
if (length(delim) >= 2) {
# If at least two --- or ... lines were found...
if (delim[[1]] == 1 || all(grepl("^\\s*$", lines[1:delim[[1]]]))) {
# and the first is a ---
if (grepl("^---\\s*$", lines[delim[[1]]])) {
# ...and the first --- line is not preceded by non-whitespace...
if (diff(delim[1:2]) > 1) {
# ...and there is actually something between the two --- lines...
yamlData <- paste(lines[(delim[[1]] + 1):(delim[[2]] - 1)],
collapse = "\n")
return(yaml::yaml.load(yamlData))
}
}
}
}
return(NULL)
}
# Adapted from rmarkdown:::is_shiny_prerendered()
is_shiny_prerendered <- function(runtime, server = NULL) {
if (!is.null(runtime) && grepl("^shiny", runtime)) {
TRUE
} else if (identical(server, "shiny")) {
TRUE
} else if (is.list(server) && identical(server[["type"]], "shiny")) {
TRUE
} else {
FALSE
}
}
# If deploying an R Markdown, Quarto, or static content, infer a primary
# document if one is not already specified.
# Note: functionality in inferQuartoInfo() depends on primary doc inference
# working the same across app modes.
inferAppPrimaryDoc <- function(appPrimaryDoc, appFiles, appMode) {
if (!is.null(appPrimaryDoc)) {
return(appPrimaryDoc)
}
# Only documents and static apps don't have primary _doc_
if (!(appIsDocument(appMode) || appMode == "static")) {
return(appPrimaryDoc)
}
# determine expected primary document extension
ext <- if (appMode == "static") "\\.html?$" else "\\.[Rq]md$"
# use index file if it exists
matching <- grepl(paste0("^index", ext), appFiles, ignore.case = TRUE)
if (!any(matching)) {
# no index file found, so pick the first one we find
matching <- grepl(ext, appFiles, ignore.case = TRUE)
if (!any(matching)) {
cli::cli_abort(c(
"Failed to determine {.arg appPrimaryDoc}.",
x = "No files matching {.str {ext}}."
))
}
}
if (sum(matching) > 1) {
# if we have multiple matches, pick the first
appFiles[matching][[1]]
} else {
appFiles[matching]
}
}
appIsDocument <- function(appMode) {
appMode %in% c(
"rmd-static",
"rmd-shiny",
"quarto-static",
"quarto-shiny"
)
}
appIsQuartoDocument <- function(appMode) {
appMode %in% c(
"quarto-static",
"quarto-shiny"
)
}
appHasParameters <- function(appDir, appPrimaryDoc, appMode, contentCategory = NULL) {
# Only Rmd deployments are marked as having parameters. Shiny applications
# may distribute an Rmd alongside app.R, but that does not cause the
# deployment to be considered parameterized.
#
# https://github.com/rstudio/rsconnect/issues/246
if (!(appIsDocument(appMode))) {
return(FALSE)
}
# Sites don't ever have parameters
if (identical(contentCategory, "site")) {
return(FALSE)
}
# Only Rmd files have parameters.
if (tolower(tools::file_ext(appPrimaryDoc)) == "rmd") {
filename <- file.path(appDir, appPrimaryDoc)
yaml <- yamlFromRmd(filename)
if (!is.null(yaml)) {
params <- yaml[["params"]]
# We don't care about deep parameter processing, only that they exist.
return(!is.null(params) && length(params) > 0)
}
}
FALSE
}
detectPythonInDocuments <- function(appDir, files = NULL) {
if (is.null(files)) {
# for testing
files <- bundleFiles(appDir)
}
rmdFiles <- grep("^[^/\\\\]+\\.[rq]md$", files, ignore.case = TRUE, perl = TRUE, value = TRUE)
for (rmdFile in rmdFiles) {
if (documentHasPythonChunk(file.path(appDir, rmdFile))) {
return(TRUE)
}
}
return(FALSE)
}
documentHasPythonChunk <- function(filename) {
lines <- readLines(filename, warn = FALSE, encoding = "UTF-8")
matches <- grep("`{python", lines, fixed = TRUE)
return(length(matches) > 0)
}
rsconnect/R/servers.R 0000644 0001762 0000144 00000020343 14513230050 014260 0 ustar ligges users #' Server metadata
#'
#' `servers()` lists all known servers; `serverInfo()` gets metadata about
#' a specific server. Cloud servers `shinyapps.io` and `posit.cloud` are always
#' automatically registered and available.
#'
#' @param name Server name. If omitted, you'll be prompted to pick a server.
#' @param local Return only local servers? (i.e. not automatically registered
#' cloud servers)
#' @return
#' `servers()` returns a data frame with registered server names and URLs.
#' `serverInfo()` returns a list with details for a particular server.
#' @export
#' @examples
#' # List all registered servers
#' servers()
#'
#' # Get information about a server
#' serverInfo("posit.cloud")
servers <- function(local = FALSE) {
servers <- serverNames(local)
info <- lapply(servers, serverInfo)
info <- lapply(info, as.data.frame, stringsAsFactors = FALSE)
out <- rbind_fill(info, c("name", "url", "certificate"))
out$certificate <- secret(out$certificate)
out
}
#' @rdname servers
#' @export
serverInfo <- function(name = NULL) {
name <- findServer(name, local = FALSE)
if (isPositCloudServer(name)) {
info <- cloudServerInfo(name, "https://api.posit.cloud/v1")
} else if (isShinyappsServer(name)) {
info <- cloudServerInfo(name, "https://api.shinyapps.io/v1")
} else {
configFile <- serverConfigFile(name)
serverDcf <- read.dcf(serverConfigFile(name), all = TRUE)
info <- as.list(serverDcf)
}
info$certificate <- secret(info$certificate)
info
}
serverNames <- function(local = FALSE) {
names <- gsub("\\.dcf$", "", basename(serverConfigFiles()))
if (!local) {
names <- c(names, "shinyapps.io", "posit.cloud")
if (nrow(accounts(server = "rstudio.cloud")) > 0) {
names <- c(names, "rstudio.cloud")
}
}
names
}
isShinyappsServer <- function(server) {
identical(server, "shinyapps.io")
}
isPositCloudServer <- function(server) {
server %in% c("posit.cloud", "rstudio.cloud")
}
isCloudServer <- function(server) {
isPositCloudServer(server) || isShinyappsServer(server)
}
checkCloudServer <- function(server, call = caller_env()) {
if (!isCloudServer(server)) {
cli::cli_abort("`server` must be shinyapps.io or posit.cloud", call = call)
}
}
checkShinyappsServer <- function(server, call = caller_env()) {
if (!isShinyappsServer(server)) {
cli::cli_abort("`server` must be shinyapps.io", call = call)
}
}
isRPubs <- function(server) {
identical(server, "rpubs.com")
}
isConnectServer <- function(server) {
!isCloudServer(server) && !isRPubs(server)
}
cloudServerInfo <- function(name, url) {
list(
name = name,
url = getOption("rsconnect.shinyapps_url", url),
certificate = inferCertificateContents(
system.file("cert/shinyapps.io.pem", package = "rsconnect")
)
)
}
findServer <- function(server = NULL,
local = TRUE,
error_call = caller_env()) {
if (!is.null(server)) {
check_string(server, call = error_call)
existing <- serverNames()
if (!server %in% existing) {
cli::cli_abort(c(
"Can't find {.arg server} with name {.str {server}}.",
i = "Known servers are {.str {existing}}."
))
}
server
} else {
existing <- servers(local = local)
if (length(existing) == 0 || nrow(existing) == 0) {
cli::cli_abort("No local servers have been registered")
} else if (nrow(existing) == 1) {
existing$name
} else {
idx <- cli_menu(
"Multiple servers found.",
"Which one do you want to use?",
c(i = "Use {.arg server} to pick one of {.str {existing$name}}."),
choices = existing$name
)
existing$name[idx]
}
}
}
#' Server management
#'
#' @description
#' These functions manage the list of known servers:
#'
#' * `addServer()` registers a Posit connect server. Once it has been
#' registered, you can connect to an account on the server using
#' [connectUser()].
#' * `removeServer()` removes a server from the registry.
#' * `addServerCertificate()` adds a certificate to a server.
#'
#' @param url URL for the server. Can be a bare hostname like
#' `connect.mycompany.com` or a url like `http://posit.mycompany.com/connect`.
#' @param name Server name. If omitted, the server hostname is used.
#' @param certificate Optional. Either a path to certificate file or a
#' character vector containing the certificate's contents.
#' @param validate Validate that `url` actually points to a Posit Connect
#' server?
#' @param quiet Suppress output and prompts where possible.
#' @export
#' @examples
#' \dontrun{
#' # register a local server
#' addServer("http://myrsconnect/", "myserver")
#'
#' # list servers
#' servers(local = TRUE)
#'
#' # connect to an account on the server
#' connectUser(server = "myserver")
#' }
#' @export
addServer <- function(url, name = NULL, certificate = NULL, validate = TRUE, quiet = FALSE) {
check_string(url)
check_name(name, allow_null = TRUE)
if (validate) {
out <- validateConnectUrl(url, certificate)
if (!out$valid) {
cli::cli_abort("{.arg url} does not appear to be a Posit Connect server.")
}
url <- out$url
}
name <- name %||% serverName(url)
registerServer(name, url, certificate)
if (!quiet) {
message("Server '", name, "' added successfully: ", url)
}
}
# Validate a connect server URL by hitting a known configuration endpoint
# The URL may be specified with or without the protocol and port; this function
# will try both http and https and follow any redirects given by the server.
validateConnectUrl <- function(url, certificate = NULL) {
# Add protocol if missing, assuming https except for local installs
if (!grepl("://", url, fixed = TRUE)) {
if (grepl(":3939", url, fixed = TRUE)) {
url <- paste0("http://", url)
} else {
url <- paste0("https://", url)
}
}
url <- ensureConnectServerUrl(url)
is_http <- grepl("^http://", url)
GET_server_settings <- function(url) {
timeout <- getOption("rsconnect.http.timeout", if (isWindows()) 20 else 10)
auth_info <- list(certificate = inferCertificateContents(certificate))
GET(
parseHttpUrl(url),
auth_info,
"/server_settings",
timeout = timeout
)
}
response <- NULL
cnd <- catch_cnd(response <- GET_server_settings(url), "error")
if (is_http && cnd_inherits(cnd, "OPERATION_TIMEDOUT")) {
url <- gsub("^http://", "https://", url)
cnd <- catch_cnd(response <- GET_server_settings(url), "error")
}
if (!is.null(cnd)) {
return(list(valid = FALSE, message = conditionMessage(cnd)))
}
contentType <- attr(response, "httpContentType")
if (!isContentType(contentType, "application/json")) {
return(list(valid = FALSE, message = "Endpoint did not return JSON"))
}
url <- gsub("/server_settings$", "", attr(response, "httpUrl"))
list(valid = TRUE, url = url, response = response)
}
# Return a URL that can be concatenated with sub-paths like /content
ensureConnectServerUrl <- function(url) {
# strip trailing /
url <- gsub("/$", "", url)
# ensure 'url' ends with '/__api__'
if (!grepl("/__api__$", url))
url <- paste(url, "/__api__", sep = "")
url
}
registerServer <- function(name, url, certificate = NULL, error_call = caller_env()) {
certificate <- inferCertificateContents(certificate)
if (!identical(substr(url, 1, 5), "https") && !is.null(certificate)) {
cli::cli_abort(
c(
"Certificates may only be attached to servers that use the HTTPS protocol.",
i = "Specify an HTTPS URL for the server, or omit the certificate."
),
call = error_call
)
}
path <- serverConfigFile(name)
fields <- list(
name = name,
url = url,
certificate = certificate %||% NA
)
write.dcf(fields, path, keep.white = "certificate")
}
#' @rdname addServer
#' @export
removeServer <- function(name = NULL) {
name <- findServer(name)
configFile <- serverConfigFile(name)
unlink(configFile)
}
#' @rdname addServer
#' @export
addServerCertificate <- function(name, certificate, quiet = FALSE) {
info <- serverInfo(name)
registerServer(name, info$url, certificate)
if (!quiet)
message("Certificate added to server '", name, "'")
invisible(NULL)
}
serverName <- function(url) {
url <- parseHttpUrl(url)
paste0(url$host, if (nchar(url$port) > 0) ":", url$port)
}
rsconnect/R/certificates.R 0000644 0001762 0000144 00000011775 14513230050 015245 0 ustar ligges users
# sanity check to make sure we're looking at an ASCII armored cert
validateCertificate <- function(certificate) {
return(any(grepl("-----BEGIN CERTIFICATE-----", certificate, fixed = TRUE)))
}
createCertificateFile <- function(certificate) {
certificateFile <- NULL
# check the R option first, then fall back on the environment variable
systemStore <- getOption("rsconnect.ca.bundle")
if (is.null(systemStore) || !nzchar(systemStore)) {
systemStore <- Sys.getenv("RSCONNECT_CA_BUNDLE")
}
# start by checking for a cert file specified in an environment variable
if (!is.null(systemStore) && nzchar(systemStore)) {
if (file.exists(systemStore)) {
certificateFile <- systemStore
} else {
warning("The certificate store '", systemStore, "' specified in the ",
if (identical(systemStore, getOption("rsconnect.ca.bundle")))
"rsconnect.ca.bundle option "
else
"RSCONNECT_CA_BUNDLE environment variable ",
"does not exist. The system certificate store will be used instead.")
}
}
# if no certificate contents specified, we're done
if (is.null(certificate))
return(certificateFile)
# if we don't have a certificate file yet, try to find the system store
if (is.null(certificateFile)) {
if (.Platform$OS.type == "unix") {
# search known locations on Unix-like
stores <- c("/etc/ssl/certs/ca-certificates.crt",
"/etc/pki/tls/certs/ca-bundle.crt",
"/usr/share/ssl/certs/ca-bundle.crt",
"/usr/local/share/certs/ca-root.crt",
"/etc/ssl/cert.pem",
"/var/lib/ca-certificates/ca-bundle.pem")
} else {
# mirror behavior of curl on Windows, which looks in system folders,
# the working directory, and %PATH%.
stores <- c(file.path(getwd(), "curl-ca-bundle.crt"),
"C:/Windows/System32/curl-ca-bundle.crt",
"C:/Windows/curl-ca-bundle.crt",
file.path(strsplit(Sys.getenv("PATH"), ";", fixed = TRUE),
"curl-ca-bundle.crt"))
}
# use our own baked-in bundle as a last resort
stores <- c(stores, system.file(package = "rsconnect", "cert", "cacert.pem"))
for (store in stores) {
if (file.exists(store)) {
# if the bundle exists, stop here
certificateFile <- store
break
}
}
# if we didn't find the system store, it's okay; the fact that we're here
# means that we have a server-specific certificate so it's probably going
# to be all right to use only that cert.
}
# create a temporary file to house the certificates
certificateStore <- tempfile(pattern = "cacerts", fileext = ".pem")
dirCreate(dirname(certificateStore))
file.create(certificateStore)
# open temporary cert store
con <- file(certificateStore, open = "at")
defer(close(con))
# copy the contents of the certificate file into the store, if we found one
# (we don't do a straight file copy since we don't want to inherit or
# correct permissions)
if (!is.null(certificateFile)) {
certLines <- readLines(certificateFile, warn = FALSE)
writeLines(text = certLines, con = con)
}
# append the server-specific certificate (with a couple of blank lines)
writeLines(text = c("", "", certificate), con = con)
return(certificateStore)
}
inferCertificateContents <- function(certificate) {
# certificate can be specified as either a character vector or a filename;
# infer which we're dealing with
# tolerate NULL, which is a valid case representing no certificate
if (is.null(certificate) || identical(certificate, ""))
return(NULL)
# collapse to a single string if we got a vector of lines
if (length(certificate) > 1)
certificate <- paste(certificate, collapse = "\n")
# looks like ASCII armored certificate data, return as-is
if (validateCertificate(substr(certificate, 1, 27)))
return(certificate)
# looks like a file; return its contents
if (file.exists(certificate)) {
if (file.size(certificate) > 1048576) {
stop("The file '", certificate, "' is too large. Certificate files must ",
"be less than 1MB.")
}
contents <- paste(readLines(con = certificate, warn = FALSE), collapse = "\n")
if (validateCertificate(contents))
return(contents)
else
stop("The file '", certificate, "' does not appear to be a certificate. ",
"Certificate files should be in ASCII armored PEM format, with a ",
"first line reading -----BEGIN CERTIFICATE-----.")
}
# doesn't look like something we can deal with; guess error based on length
if (nchar(certificate) < 200) {
stop("The certificate file '", certificate, "' does not exist.")
} else {
stop("The certificate '", substr(certificate, 1, 10), "...' is not ",
"correctly formed. Specify the certificate as either an ASCII armored string, ",
"beginning with -----BEGIN CERTIFICATE----, or a valid path to a file ",
"containing the certificate.")
}
}
rsconnect/R/deploymentTarget.R 0000644 0001762 0000144 00000030156 14522164250 016131 0 ustar ligges users # Discover the deployment target given the passed information.
#
# Returns a list containing a deployment record and the account details to use
# when performing the deployment.
#
# When appId is provided, it must identify an existing application. The
# application may have been created by some other user. That application may
# or may not have an existing deployment record on disk.
#
# When using appId, a search across all deployment records occurs, even when
# there is no local account+server referenced by the deployment record. This
# lets us identify on-disk deployment records created by some collaborator.
# When there is no on-disk deployment record, the configured account+server is
# queried for the appId.
#
# It is an error when appId does not identify an existing application.
#
# When appName is provided, it may identify an existing application owned by
# the calling user (e.g. associated with a locally known account).
#
# When using appName, the search across deployment records is restricted to
# the incoming account+server. When there is no incoming account+server, the
# search is restricted to deployments which have a corresponding local
# account.
#
# Without appId or appName to identify an existing deployment, deployment
# records associated with local accounts (possibly restricted by incoming
# account+server) are considered before falling back to a generated name.
#
# When the targeted name does not exist locally or on the targeted
# account+server, a deployment record with NULL appId is returned, which
# signals to the caller that an application should be created.
findDeploymentTarget <- function(
recordPath = ".",
appId = NULL,
appName = NULL,
appTitle = NULL,
envVars = NULL,
account = NULL,
server = NULL,
forceUpdate = FALSE,
error_call = caller_env()
) {
if (!is.null(appId)) {
return(findDeploymentTargetByAppId(
recordPath = recordPath,
appId = appId,
appName = appName,
appTitle = appTitle,
envVars = envVars,
account = account,
server = server,
error_call = error_call
))
}
if (!is.null(appName)) {
return(findDeploymentTargetByAppName(
recordPath = recordPath,
appName = appName,
appTitle = appTitle,
envVars = envVars,
account = account,
server = server,
forceUpdate = forceUpdate,
error_call = error_call
))
}
# No identifying appId or appName.
# When there are existing deployments, ask the user to select one and use
# it. Only deployments associated with locally configured account+server
# combinations are considered.
allDeployments <- deployments(
appPath = recordPath,
accountFilter = account,
serverFilter = server
)
if (nrow(allDeployments) > 0) {
deployment <- disambiguateDeployments(allDeployments, error_call = error_call)
deployment <- updateDeployment(deployment, appTitle, envVars)
accountDetails <- findAccountInfo(deployment$account, deployment$server, error_call = error_call)
return(list(
accountDetails = accountDetails,
deployment = deployment
))
}
# 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)
return(findDeploymentTargetByAppName(
recordPath = recordPath,
appName = appName,
appTitle = appTitle,
envVars = envVars,
account = accountDetails$name,
server = accountDetails$server,
forceUpdate = forceUpdate,
error_call = error_call
))
}
# Discover the deployment target given appId.
#
# When appId is provided, all other information is secondary. An appId is an
# indication from the caller that the content has already been deployed
# elsewhere. If we cannot locate that content, deployment fails.
#
# Local deployment records are considered first before looking for the appId
# on the target server.
#
# The target content may have been created by some other user; the account for
# this session may differ from the account used when creating the content.
findDeploymentTargetByAppId <- function(
recordPath = ".",
appId = NULL,
appName = NULL,
appTitle = NULL,
envVars = NULL,
account = NULL,
server = NULL,
error_call = caller_env()
) {
# We must have a target account+server in order to use the appId.
# The selected account may not be the original creator of the content.
accountDetails <- findAccountInfo(account, server, error_call = error_call)
# Filtering is only by server and includes all deployments in case we have a deployment record
# from a collaborator.
appDeployments <- deployments(
appPath = recordPath,
serverFilter = server,
excludeOrphaned = FALSE
)
appDeployments <- appDeployments[appDeployments$appId == appId, ]
if (nrow(appDeployments) > 1) {
cli::cli_abort(
c(
"Supplied {.arg appId} ({appId}) identifies multiple deployments.",
i = "Manage obsolete deployments with rsconnect::forgetDeployment()."
),
call = error_call
)
}
# Existing local deployment record.
if (nrow(appDeployments) == 1) {
deployment <- appDeployments[1, ]
deployment <- updateDeployment(deployment, appTitle, envVars)
return(list(
accountDetails = accountDetails,
deployment = deployment
))
}
# No local deployment record. Get it from the server.
application <- getApplication(accountDetails$name, accountDetails$server, appId)
# Note: The account+server of this deployment record may
# not correspond to the original content creator.
deployment <- createDeploymentFromApplication(application, accountDetails)
deployment <- updateDeployment(deployment, appTitle, envVars)
return(list(
accountDetails = accountDetails,
deployment = deployment
))
}
# Discover the deployment target given appName.
#
# When appName is provided it identifies content previously created by a
# locally configured account.
#
# The account details from the deployment record identify the final
# credentials we will use, as account+server may not have been specified by
# the caller.
findDeploymentTargetByAppName <- function(
recordPath = ".",
appName = NULL,
appTitle = NULL,
envVars = NULL,
account = NULL,
server = NULL,
forceUpdate = FALSE,
error_call = caller_env()
) {
appDeployments <- deployments(
appPath = recordPath,
nameFilter = appName,
accountFilter = account,
serverFilter = server
)
# When the appName along with the (optional) account+server identifies
# exactly one previous deployment, use it.
if (nrow(appDeployments) == 1) {
deployment <- appDeployments[1, ]
deployment <- updateDeployment(deployment, appTitle, envVars)
accountDetails <- findAccountInfo(deployment$account, deployment$server, error_call = error_call)
return(list(
accountDetails = accountDetails,
deployment = deployment
))
}
# When the appName identifies multiple records, we may not have had an
# account+server constraint. Ask the user to choose.
if (nrow(appDeployments) > 1) {
deployment <- disambiguateDeployments(appDeployments, error_call = error_call)
deployment <- updateDeployment(deployment, appTitle, envVars)
accountDetails <- findAccountInfo(deployment$account, deployment$server, error_call = error_call)
return(list(
accountDetails = accountDetails,
deployment = deployment
))
}
# When the appName does not identify a record, see if it exists on the
# server. That content is conditionally used. A resolved account is
# required.
accountDetails <- findAccountInfo(account, server, error_call = error_call)
if (!isPositCloudServer(accountDetails$server)) {
client <- clientForAccount(accountDetails)
application <- tryCatch(
getAppByName(client, accountDetails, appName, error_call = error_call),
rsconnect_app_not_found = function(err) NULL
)
if (!is.null(application)) {
uniqueName <- findUnique(appName, application$name)
if (shouldUpdateApp(application, uniqueName, forceUpdate, error_call = error_call)) {
deployment <- createDeploymentFromApplication(application, accountDetails)
deployment <- updateDeployment(deployment, appTitle, envVars)
return(list(
accountDetails = accountDetails,
deployment = deployment
))
} else {
appName <- uniqueName
}
}
}
# No existing deployment, or the caller does not want to re-use that content.
deployment <- createDeployment(
appName = appName,
appTitle = appTitle,
appId = NULL,
envVars = envVars,
username = accountDetails$name,
account = accountDetails$name,
server = accountDetails$server
)
return(list(
accountDetails = accountDetails,
deployment = deployment
))
}
createDeployment <- function(appName,
appTitle,
appId,
envVars,
username,
account,
server,
version = deploymentRecordVersion) {
# Consider merging this object with the object returned by
# deploymentRecord().
#
# Field names are shared with deploymentRecord() objects to avoid lots of
# record rewriting. Objects returned by findDeploymentTargetByAppName may
# have fields from the on-disk records, which were created by
# deploymentRecord().
list(
name = appName,
title = appTitle %||% "",
envVars = envVars,
appId = appId,
username = username,
account = account,
server = server,
version = version
)
}
createDeploymentFromApplication <- function(application, accountDetails) {
createDeployment(
appName = application$name,
appTitle = application$title,
appId = application$id,
envVars = NULL,
username = application$owner_username %||% accountDetails$name,
account = accountDetails$name,
server = accountDetails$server
)
}
updateDeployment <- function(previous, appTitle = NULL, envVars = NULL) {
createDeployment(
appName = previous$name,
appTitle = appTitle %||% previous$title,
appId = previous$appId,
envVars = envVars %||% previous$envVars[[1]],
# if username not previously recorded, use current account
username = previous$username %||% previous$account,
account = previous$account,
server = previous$server,
version = previous$version
)
}
defaultAppName <- function(recordPath, server = NULL) {
if (isDocumentPath(recordPath)) {
name <- file_path_sans_ext(basename(recordPath))
if (name == "index") {
# parent directory will give more informative name
name <- basename(dirname(recordPath))
} else {
# deploying a document
}
} else {
# deploying a directory
name <- basename(recordPath)
}
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)
}
}
name
}
shouldUpdateApp <- function(application,
uniqueName,
forceUpdate = FALSE,
error_call = caller_env()) {
if (forceUpdate) {
return(TRUE)
}
message <- c(
"Discovered a previously deployed app named {.str {application$name}}",
"(View it at {.url {application$url}})"
)
prompt <- "What do you want to do?"
choices <- c(
"Update the existing app.",
"Create a new app with automatically generated name ({.str {uniqueName}}).",
"Abort this deployment and supply a custom `appName`."
)
not_interactive <- c(
i = "Set `forceUpdate = TRUE` to update it.",
i = "Supply a unique `appName` to deploy a new application."
)
cli_menu(message, prompt, choices, not_interactive, quit = 3, error_call = error_call) == 1
}
findUnique <- function(x, existing) {
i <- 1
name <- paste0(x, "-", i)
while (name %in% existing) {
i <- i + 1
name <- paste0(x, "-", i)
}
name
}
rsconnect/R/purgeApp.R 0000644 0001762 0000144 00000002303 14513230050 014346 0 ustar ligges users #' Purge an Application
#'
#' Purge a currently archived ShinyApps application.
#'
#' @param appName Name of application to purge
#' @param account Account name. If a single account is registered on the system
#' then this parameter can be omitted.
#' @param server Server name. Required only if you use the same account name on
#' multiple servers (see [servers()])
#' @param quiet Request that no status information be printed to the console
#' during the termination.
#'
#' @note This function only works for ShinyApps servers.
#'
#' @examples
#' \dontrun{
#'
#' # purge an application
#' purgeApp("myapp")
#' }
#' @seealso [applications()], [deployApp()], and
#' [restartApp()]
#' @export
purgeApp <- function(appName, account = NULL, server = NULL,
quiet = FALSE) {
accountDetails <- accountInfo(account, server)
checkShinyappsServer(accountDetails$server)
# define purge task
taskDef <- list()
taskDef$beginStatus <- "Purging application"
taskDef$endStatus <- "Application successfully purged"
taskDef$action <- function(client, application) {
client$purgeApplication(application$id)
}
# perform it
applicationTask(taskDef, appName, accountDetails, quiet)
}
rsconnect/R/bundleFiles.R 0000644 0001762 0000144 00000022044 14513230050 015023 0 ustar ligges users #' Gather files to be bundled with an app
#'
#' @description
#' Given an app directory, and optional `appFiles` and `appFileManifest`
#' arguments, returns vector of paths to bundle in the app. (Note that
#' documents follow a different strategy; see [deployDoc()] for details.)
#'
#' When neither `appFiles` nor `appFileManifest` is supplied,
#' `listDeploymentFiles()` will include all files under `appDir`, apart
#' from the following:
#'
#' * Certain files and folders that don't need to be bundled, such as
#' version control directories, internal config files, and RStudio state,
#' are automatically excluded.
#'
#' * You can exclude additional files by listing them in in a `.rscignore`
#' file. This file must have one file or directory per line (with path
#' relative to the current directory). It doesn't support wildcards, or
#' ignoring files in subdirectories.
#'
#' `listDeploymentFiles()` will throw an error if the total file size exceeds
#' the maximum bundle size (as controlled by option `rsconnect.max.bundle.size`),
#' or the number of files exceeds the maximum file limit (as controlled by
#' option `rsconnect.max.bundle.files`). This prevents you from accidentally
#' bundling a very large direcfory (i.e. you home directory).
#'
#' @inheritParams deployApp
#' @param error_call The call or environment for error reporting; expert
#' use only.
#' @return Character of paths to bundle, relative to `appDir`.
#' @export
listDeploymentFiles <- function(appDir,
appFiles = NULL,
appFileManifest = NULL,
error_call = caller_env()) {
no_content <- function(message) {
cli::cli_abort(
c("No content to deploy.", x = message),
call = error_call
)
}
if (!is.null(appFiles) && !is.null(appFileManifest)) {
cli::cli_abort(
"Must specify at most one of {.arg appFiles} and {.arg appFileManifest}",
call = error_call
)
} else if (is.null(appFiles) && is.null(appFileManifest)) {
# no files supplied at all, just bundle the whole directory
appFiles <- bundleFiles(appDir)
if (length(appFiles) == 0) {
no_content("{.arg appDir} is empty.")
}
} else if (!is.null(appFiles)) {
check_character(appFiles, allow_null = TRUE, call = error_call)
appFiles <- explodeFiles(appDir, appFiles, "appFiles")
if (length(appFiles) == 0) {
no_content("{.arg appFiles} didn't match any files in {.arg appDir}.")
}
} else if (!is.null(appFileManifest)) {
check_file(appFileManifest, error_call = error_call)
appFiles <- readFileManifest(appFileManifest)
appFiles <- explodeFiles(appDir, appFiles, "appFileManifest")
if (length(appFiles) == 0) {
no_content("{.arg appFileManifest} contains no usable files.")
}
}
appFiles
}
readFileManifest <- function(appFileManifest, error_call = caller_env()) {
lines <- readLines(appFileManifest, warn = FALSE)
# remove empty/comment lines
lines <- lines[nzchar(lines)]
lines <- lines[!grepl("^#", lines)]
lines
}
#' List Files to be Bundled
#'
#' @description
#' `r lifecycle::badge("superseded")`
#'
#' `listBundleFiles()` has been superseded in favour of [listDeploymentFiles()].
#'
#' Given a directory containing an application, returns the names of the files
#' that by default will be bundled in the application. It works similarly to
#' a recursive directory listing from [list.files()] but enforces bundle sizes
#' as described in [listDeploymentFiles()]
#'
#' @param appDir Directory containing the application.
#' @return Returns a list containing the following elements:
#' * `totalFiles`: Total number of files.
#' * `totalSize`: Total size of the files (in bytes).
#' * `contents`: Paths to bundle, relative to `appDir`.
#' @export
#' @keywords internal
listBundleFiles <- function(appDir) {
recursiveBundleFiles(appDir)
}
bundleFiles <- function(appDir) {
listBundleFiles(appDir)$contents
}
explodeFiles <- function(dir, files, error_arg = "appFiles") {
missing <- !file.exists(file.path(dir, files))
if (any(missing)) {
cli::cli_warn(c(
"All files listed in {.arg {error_arg}} must exist.",
"Problems: {.file {files[missing]}}"
))
files <- files[!missing]
}
recursiveBundleFiles(dir, contents = files, ignoreFiles = FALSE)$contents
}
recursiveBundleFiles <- function(dir,
contents = NULL,
rootDir = dir,
totalFiles = 0,
totalSize = 0,
ignoreFiles = TRUE) {
# generate a list of files at this level
if (is.null(contents)) {
contents <- list.files(dir, all.files = TRUE, no.. = TRUE)
}
if (ignoreFiles) {
contents <- ignoreBundleFiles(dir, contents)
}
# Info for each file lets us know to recurse (directories) or aggregate (files).
is_dir <- dir.exists(file.path(dir, contents))
names(is_dir) <- contents
children <- character()
for (name in contents) {
if (isTRUE(is_dir[[name]])) {
out <- recursiveBundleFiles(
dir = file.path(dir, name),
rootDir = rootDir,
totalFiles = totalFiles,
totalSize = totalSize,
ignoreFiles = ignoreFiles
)
children <- append(children, file.path(name, out$contents))
totalFiles <- out$totalFiles
totalSize <- out$totalSize
} else {
children <- append(children, name)
totalFiles <- totalFiles + 1
totalSize <- totalSize + file_size(file.path(dir, name))
}
enforceBundleLimits(rootDir, totalFiles, totalSize)
}
list(
contents = children,
totalFiles = totalFiles,
totalSize = totalSize
)
}
ignoreBundleFiles <- function(dir, contents) {
# entries ignored regardless of type
ignored <- c(
# rsconnect packages
"rsconnect", "rsconnect-python", "manifest.json",
# packrat + renv,
"renv", "packrat",
# version control
".git", ".gitignore", ".svn",
# R/RStudio
".Rhistory", ".Rproj.user",
# other
".DS_Store", ".quarto", "app_cache", "__pycache__/"
)
contents <- setdiff(contents, ignored)
contents <- contents[!isKnitrCacheDir(contents)]
contents <- contents[!isPythonEnv(dir, contents)]
contents <- contents[!grepl("^~|~$", contents)]
contents <- contents[!grepl(glob2rx("*.Rproj"), contents)]
# remove any files lines listed .rscignore
if (".rscignore" %in% contents) {
ignoreContents <- readLines(file.path(dir, ".rscignore"))
contents <- setdiff(contents, c(ignoreContents, ".rscignore"))
}
contents
}
isKnitrCacheDir <- function(files) {
is_cache <- grepl("^.+_cache$", files)
cache_rmd <- gsub("_cache$", ".Rmd", files)
has_rmd <- tolower(cache_rmd) %in% tolower(files)
ifelse(is_cache, has_rmd, FALSE)
}
# https://github.com/rstudio/rsconnect-python/blob/94dbd28797ee503d6/rsconnect/bundle.py#L541-L543
isPythonEnv <- function(dir, files) {
(file.exists(file.path(dir, files, "bin", "python")) |
file.exists(file.path(dir, files, "Scripts", "python.exe")) |
file.exists(file.path(dir, files, "Scripts", "pythond.exe")) |
file.exists(file.path(dir, files, "Scripts", "pythonw.exe")))
}
enforceBundleLimits <- function(appDir, totalFiles, totalSize) {
maxSize <- getOption("rsconnect.max.bundle.size", 3000 * 1024^2)
maxFiles <- getOption("rsconnect.max.bundle.files", 10000)
if (totalSize > maxSize) {
cli::cli_abort(c(
"{.arg appDir} ({.path {appDir}}) is too large to be deployed.",
x = "The maximum size is {maxSize} bytes.",
x = "This directory is at least {totalSize} bytes.",
i = "Remove some files or adjust the rsconnect.max.bundle.size option."
))
}
if (totalFiles > maxFiles) {
cli::cli_abort(c(
"{.arg appDir} ({.path {appDir}}) is too large to be deployed.",
x = "The maximum number of files is {maxFiles}.",
x = "This directory contains at least {totalFiles} files.",
i = "Remove some files or adjust the rsconnect.max.bundle.files option."
))
}
}
# Scan the bundle directory looking for long user/group names.
#
# Warn that the internal tar implementation may produce invalid archives.
# https://github.com/rstudio/rsconnect/issues/446
# https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17871
detectLongNames <- function(bundleDir, lengthLimit = 32) {
files <- list.files(
bundleDir,
recursive = TRUE,
all.files = TRUE,
include.dirs = TRUE,
no.. = TRUE
)
info <- file.info(file.path(bundleDir, files))
ok <- (is.na(info$uname) | nchar(info$uname) <= lengthLimit) &
(is.na(info$grname) | nchar(info$grname) <= lengthLimit)
if (all(ok)) {
return(invisible(FALSE))
}
bad_files <- files[!ok]
cli::cli_warn(
c(
"The bundle contains files with user/group names longer than {lengthLimit}.",
x = "Files: {.path {bad_files}}",
x = "Long user and group names cause the internal R tar implementation to produce invalid archives",
i = "Set the {.code rsconnect.tar} option or the {.code RSCONNECT_TAR} environment variable to the path to a tar executable."
)
)
return(invisible(FALSE))
}
rsconnect/R/terminateApp.R 0000644 0001762 0000144 00000002373 14513230050 015223 0 ustar ligges users #' Terminate an Application
#'
#' Terminate and archive a currently deployed ShinyApps application.
#'
#' @param appName Name of application to terminate
#' @param account Account name. If a single account is registered on the system
#' then this parameter can be omitted.
#' @param server Server name. Required only if you use the same account name on
#' multiple servers (see [servers()])
#' @param quiet Request that no status information be printed to the console
#' during the termination.
#'
#' @note This function only works for ShinyApps servers.
#'
#' @examples
#' \dontrun{
#'
#' # terminate an application
#' terminateApp("myapp")
#' }
#' @seealso [applications()], [deployApp()], and
#' [restartApp()]
#' @export
terminateApp <- function(appName, account = NULL, server = NULL,
quiet = FALSE) {
accountDetails <- accountInfo(account, server)
checkShinyappsServer(accountDetails$server)
# define terminate task
taskDef <- list()
taskDef$beginStatus <- "Terminating application"
taskDef$endStatus <- "Application successfully terminated"
taskDef$action <- function(client, application) {
client$terminateApplication(application$id)
}
# perform it
applicationTask(taskDef, appName, accountDetails, quiet)
}
rsconnect/R/applications.R 0000644 0001762 0000144 00000024151 14516247550 015276 0 ustar ligges users
#' List Deployed Applications
#'
#' List all applications currently deployed for a given account.
#' @inheritParams deployApp
#' @return
#' Returns a data frame with the following columns:
#' \tabular{ll}{
#' `id` \tab Application unique id \cr
#' `name` \tab Name of application \cr
#' `title` \tab Application title \cr
#' `url` \tab URL where application can be accessed \cr
#'
#' `status` \tab Current status of application. Valid values are `pending`,
#' `deploying`, `running`, `terminating`, and `terminated` \cr
#' `size` \tab Instance size (small, medium, large, etc.) (on
#' ShinyApps.io) \cr
#' `instances` \tab Number of instances (on ShinyApps.io) \cr
#' `config_url` \tab URL where application can be configured \cr
#' }
#' @note To register an account you call the [setAccountInfo()] function.
#' @examples
#' \dontrun{
#'
#' # list all applications for the default account
#' applications()
#'
#' # list all applications for a specific account
#' applications("myaccount")
#'
#' # view the list of applications in the data viewer
#' View(applications())
#' }
#' @seealso [deployApp()], [terminateApp()]
#' @family Deployment functions
#' @export
applications <- function(account = NULL, server = NULL) {
# resolve account and create connect client
accountDetails <- accountInfo(account, server)
serverDetails <- serverInfo(accountDetails$server)
client <- clientForAccount(accountDetails)
isConnect <- isConnectServer(accountDetails$server)
# retrieve applications
apps <- client$listApplications(accountDetails$accountId)
# extract the subset of fields we're interested in
keep <- if (isConnect) {
c(
"id",
"name",
"title",
"url",
"build_status",
"created_time",
"last_deployed_time",
"guid"
)
} else {
c(
"id",
"name",
"url",
"status",
"created_time",
"updated_time",
"deployment"
)
}
res <- lapply(apps, `[`, keep)
res <- if (isConnect) {
lapply(res, function(x) {
# set size and instance to NA since Connect doesn't return this info
x$size <- NA
x$instances <- NA
x$title <- x$title %||% NA_character_
x
})
} else {
lapply(res, function(x) {
# promote the size and instance data to first-level fields
x$size <- x$deployment$properties$application.instances.template
if (is.null(x$size))
x$size <- NA
x$instances <- x$deployment$properties$application.instances.count
if (is.null(x$instances))
x$instances <- NA
x$deployment <- NULL
x$guid <- NA
x$title <- NA_character_
x
})
}
# The config URL may be provided by the server at some point, but for now
# infer it from the account type
res <- lapply(res, function(row) {
if (isConnect) {
prefix <- sub("/__api__", "", serverDetails$url)
row$config_url <- paste(prefix, "connect/#/apps", row$id, sep = "/")
} else {
row$config_url <- paste("https://www.shinyapps.io/admin/#/application", row$id, sep = "/")
}
row
})
# convert to data frame
res <- lapply(res, as.data.frame, stringsAsFactors = FALSE)
res <- do.call("rbind", res)
# Ensure the Connect and ShinyApps.io data frames have same column names
idx <- match("last_deployed_time", names(res))
if (!is.na(idx)) names(res)[idx] <- "updated_time"
idx <- match("build_status", names(res))
if (!is.na(idx)) names(res)[idx] <- "status"
return(res)
}
# Use the API to filter applications by name and error when it does not exist.
getAppByName <- function(client, accountInfo, name, error_call = caller_env()) {
# NOTE: returns a list with 0 or 1 elements
app <- client$listApplications(accountInfo$accountId, filters = list(name = name))
if (length(app)) {
return(app[[1]])
}
cli::cli_abort(
c(
"No application found",
i = "Specify the application directory, name, and/or associated account."
),
call = error_call,
class = "rsconnect_app_not_found"
)
}
# Use the API to list all applications then filter the results client-side.
resolveApplication <- function(accountDetails, appName) {
client <- clientForAccount(accountDetails)
apps <- client$listApplications(accountDetails$accountId)
for (app in apps) {
if (identical(app$name, appName))
return(app)
}
stopWithApplicationNotFound(appName)
}
getApplication <- function(account, server, appId) {
accountDetails <- accountInfo(account, server)
client <- clientForAccount(accountDetails)
withCallingHandlers(
client$getApplication(appId, "unknown"),
rsconnect_http_404 = function(err) {
cli::cli_abort("Can't find app with id {.str {appId}}", parent = err)
}
)
}
stopWithApplicationNotFound <- function(appName) {
stop(paste("No application named '", appName, "' is currently deployed.",
sep = ""), call. = FALSE)
}
applicationTask <- function(taskDef, appName, accountDetails, quiet) {
# resolve target account and application
application <- resolveApplication(accountDetails, appName)
# get status function and display initial status
displayStatus <- displayStatus(quiet)
displayStatus(paste(taskDef$beginStatus, "...\n", sep = ""))
# perform the action
client <- clientForAccount(accountDetails)
task <- taskDef$action(client, application)
client$waitForTask(task$task_id, quiet)
displayStatus(paste(taskDef$endStatus, "\n", sep = ""))
invisible(NULL)
}
# streams application logs from ShinyApps
streamApplicationLogs <- function(authInfo, applicationId, entries, skip) {
# build the URL
url <- paste0(serverInfo("shinyapps.io")$url, "/applications/", applicationId,
"/logs?", "count=", entries, "&tail=1")
parsed <- parseHttpUrl(url)
# create the curl handle and perform the minimum necessary to create an
# authenticated request. we ignore the rsconnect.http option here because only
# curl supports the kind of streaming connection that we need.
handle <- createCurlHandle("GET")
curl::handle_setheaders(handle,
.list = signatureHeaders(authInfo, "GET", parsed$path, NULL)
)
# begin the stream
curl::curl_fetch_stream(url = url,
fun = function(data) {
if (skip > 0)
skip <<- skip - 1
else
cat(rawToChar(data))
}, handle = handle)
}
#' Show Application Logs
#'
#' Show the logs for a deployed ShinyApps application.
#'
#' @param appPath The path to the directory or file that was deployed.
#' @param appFile The path to the R source file that contains the application
#' (for single file applications).
#' @param appName The name of the application to show logs for. May be omitted
#' if only one application deployment was made from `appPath`.
#' @param account The account under which the application was deployed. May be
#' omitted if only one account is registered on the system.
#' @param server Server name. Required only if you use the same account name on
#' multiple servers.
#' @param entries The number of log entries to show. Defaults to 50 entries.
#' @param streaming Whether to stream the logs. If `TRUE`, then the
#' function does not return; instead, log entries are written to the console
#' as they are made, until R is interrupted. Defaults to `FALSE`.
#'
#' @note This function only uses the \code{libcurl} transport, and works only for
#' ShinyApps servers.
#'
#' @export
showLogs <- function(appPath = getwd(), appFile = NULL, appName = NULL,
account = NULL, server = NULL, entries = 50, streaming = FALSE) {
# determine the log target and target account info
deployment <- findDeployment(
appPath = appPath,
appName = appName,
server = server,
account = account
)
accountDetails <- accountInfo(deployment$account, deployment$server)
client <- clientForAccount(accountDetails)
application <- getAppByName(client, accountDetails, deployment$name)
if (streaming) {
# streaming; poll for the entries directly
skip <- 0
repeat {
tryCatch({
streamApplicationLogs(accountDetails, application$id, entries, skip)
# after the first fetch, we've seen all recent entries, so show
# only new entries. unfortunately /logs/ doesn't support getting 0
# entries, so get one and don't log it.
entries <- 1
skip <- 1
},
error = function(e) {
# if the server times out, ignore the error; otherwise, let it
# bubble through
if (!identical(e$message,
"transfer closed with outstanding read data remaining")) {
stop(e)
}
})
}
} else {
# if not streaming, poll for the entries directly
logs <- client$getLogs(application$id, entries)
cat(logs)
}
}
#' Update deployment records
#'
#' Update the deployment records for applications published to Posit Connect.
#' This updates application title and URL, and deletes records for deployments
#' where the application has been deleted on the server.
#'
#' @param appPath The path to the directory or file that was deployed.
#' @export
syncAppMetadata <- function(appPath = ".") {
check_directory(appPath)
deploys <- deployments(appPath)
for (i in seq_len(nrow(deploys))) {
curDeploy <- deploys[i, ]
# don't sync if published to RPubs
if (isRPubs(curDeploy$server)) {
next
}
account <- accountInfo(curDeploy$account, curDeploy$server)
client <- clientForAccount(account)
application <- tryCatch(
client$getApplication(curDeploy$appId),
rsconnect_http_404 = function(c) {
# if the app has been deleted, delete the deployment record
file.remove(curDeploy$deploymentFile)
cli::cli_inform("Deleting deployment record for deleted app {curDeploy$appId}.")
NULL
}
)
if (is.null(application)) {
next
}
# update the record and save out a new config file
path <- curDeploy$deploymentFile
curDeploy$deploymentFile <- NULL # added on read
# remove old fields
curDeploy$when <- NULL
curDeploy$lastSyncTime <- NULL
curDeploy$title <- application$title
curDeploy$url <- application$url
writeDeploymentRecord(curDeploy, path)
}
}
rsconnect/R/bundle.R 0000644 0001762 0000144 00000017734 14513230050 014052 0 ustar ligges users # Given a path to an directory and a list of files in that directory, copies
# those files to a new temporary directory. Performs some small modifications
# in this process, including renaming single-file Shiny apps to "app.R" and
# stripping packrat and renv commands from .Rprofile. Returns the path to the
# temporary directory.
bundleAppDir <- function(appDir, appFiles, appPrimaryDoc = NULL, verbose = FALSE) {
logger <- verboseLogger(verbose)
logger("Creating tempfile for appdir")
# create a directory to stage the application bundle in
bundleDir <- dirCreate(tempfile())
defer(unlink(bundleDir))
logger("Copying files")
# copy the files into the bundle dir
for (file in appFiles) {
logger("Copying", file)
from <- file.path(appDir, file)
to <- file.path(bundleDir, file)
# if deploying a single-file Shiny application, name it "app.R" so it can
# be run as an ordinary Shiny application
if (is.character(appPrimaryDoc) &&
tolower(tools::file_ext(appPrimaryDoc)) == "r" &&
file == appPrimaryDoc) {
to <- file.path(bundleDir, "app.R")
}
dirCreate(dirname(to))
file.copy(from, to, copy.date = TRUE)
# ensure .Rprofile doesn't call packrat/init.R or renv/activate.R
if (basename(to) == ".Rprofile") {
tweakRProfile(to)
}
}
bundleDir
}
tweakRProfile <- function(path) {
lines <- readLines(path)
packratLines <- grep('source("packrat/init.R")', lines, fixed = TRUE)
if (length(packratLines) > 0) {
lines[packratLines] <- paste0(
"# Packrat initialization disabled in published application\n",
'# source("packrat/init.R")'
)
}
renvLines <- grep('source("renv/activate.R")', lines, fixed = TRUE)
if (length(renvLines) > 0) {
lines[renvLines] <- paste0(
"# renv initialization disabled in published application\n",
'# source("renv/activate.R")'
)
}
if (length(renvLines) > 0 || length(packratLines) > 0) {
msg <- sprintf(
"# Modified by rsconnect package %s on %s",
packageVersion("rsconnect"),
Sys.time()
)
lines <- c(msg, lines)
}
writeLines(lines, path)
}
# Writes a tar.gz file located at bundlePath containing all files in bundleDir.
writeBundle <- function(bundleDir, bundlePath, verbose = FALSE) {
logger <- verboseLogger(verbose)
prevDir <- setwd(bundleDir)
defer(setwd(prevDir))
tarImplementation <- getTarImplementation()
logger("Using tar: ", tarImplementation)
if (tarImplementation == "internal") {
detectLongNames(bundleDir)
}
utils::tar(bundlePath, files = NULL, compression = "gzip", tar = tarImplementation)
}
getTarImplementation <- function() {
# Check the rsconnect.tar option first. If that is unset, check the
# RSCONNECT_TAR environment var. If neither are set, use "internal".
tarImplementation <- getOption("rsconnect.tar", default = NA)
if (is.na(tarImplementation) || !nzchar(tarImplementation)) {
tarImplementation <- Sys.getenv("RSCONNECT_TAR", unset = NA)
}
if (is.na(tarImplementation) || !nzchar(tarImplementation)) {
tarImplementation <- "internal"
}
return(tarImplementation)
}
isWindows <- function() {
Sys.info()[["sysname"]] == "Windows"
}
createAppManifest <- function(appDir,
appMetadata,
users = NULL,
pythonConfig = NULL,
retainPackratDirectory = TRUE,
image = NULL,
envManagement = NULL,
envManagementR = NULL,
envManagementPy = NULL,
verbose = FALSE,
quiet = FALSE) {
if (needsR(appMetadata)) {
extraPackages <- inferRPackageDependencies(appMetadata)
# provide package entries for all dependencies
packages <- bundlePackages(
bundleDir = appDir,
extraPackages = extraPackages,
verbose = verbose,
quiet = quiet
)
} else {
packages <- list()
}
needsPython <- appMetadata$documentsHavePython ||
"jupyter" %in% appMetadata$quartoInfo$engines ||
"reticulate" %in% names(packages)
if (needsPython && !is.null(pythonConfig)) {
python <- pythonConfig(appDir)
packageFile <- file.path(appDir, python$package_manager$package_file)
writeLines(python$package_manager$contents, packageFile)
python$package_manager$contents <- NULL
} else {
python <- NULL
}
if (!retainPackratDirectory) {
# Optionally remove the packrat directory when it will not be included in
# deployments, such as manifest-only deployments.
unlink(file.path(appDir, "packrat"), recursive = TRUE)
}
# build the list of files to checksum
files <- list.files(appDir, recursive = TRUE, all.files = TRUE,
full.names = FALSE)
# provide checksums for all files
filelist <- list()
for (file in files) {
filepath <- file.path(appDir, file)
checksum <- list(checksum = fileMD5(filepath))
filelist[[file]] <- I(checksum)
}
# create userlist
userlist <- list()
if (!is.null(users) && length(users) > 0) {
for (i in 1:nrow(users)) {
user <- users[i, "user"]
hash <- users[i, "hash"]
userinfo <- list()
userinfo$hash <- hash
userlist[[user]] <- userinfo
}
}
# create the manifest
manifest <- list()
manifest$version <- 1
manifest$locale <- getOption("rsconnect.locale", detectLocale())
manifest$platform <- paste(R.Version()$major, R.Version()$minor, sep = ".")
metadata <- list(appmode = appMetadata$appMode)
# emit appropriate primary document information
primaryDoc <- ifelse(is.null(appMetadata$appPrimaryDoc) ||
tolower(tools::file_ext(appMetadata$appPrimaryDoc)) == "r",
NA, appMetadata$appPrimaryDoc)
metadata$primary_rmd <- ifelse(appMetadata$appMode %in% c("rmd-shiny", "rmd-static", "quarto-shiny", "quarto-static"), primaryDoc, NA)
metadata$primary_html <- ifelse(appMetadata$appMode == "static", primaryDoc, NA)
# emit content category (plots, etc)
metadata$content_category <- ifelse(!is.null(appMetadata$contentCategory),
appMetadata$contentCategory, NA)
metadata$has_parameters <- appMetadata$hasParameters
# add metadata
manifest$metadata <- metadata
# handle shorthand arg to enable/disable both R and Python
if (!is.null(envManagement)) {
envManagementR <- envManagement
envManagementPy <- envManagement
}
# if envManagement is explicitly enabled/disabled,
# create an environment_management obj
envManagementInfo <- list()
if (!is.null(envManagementR)) {
envManagementInfo$r <- envManagementR
}
if (!is.null(envManagementPy)) {
envManagementInfo$python <- envManagementPy
}
# emit the environment field
if (!is.null(image) || length(envManagementInfo) > 0) {
manifest$environment <- list()
# if there is a target image, attach it to the environment
if (!is.null(image)) {
manifest$environment$image <- image
}
# if either environment_management.r or environment_management.python
# is provided, write the environment_management field
if (length(envManagementInfo) > 0) {
manifest$environment$environment_management <- envManagementInfo
}
}
# indicate whether this is a quarto app/doc
manifest$quarto <- appMetadata$quartoInfo
# if there is python info for reticulate or Quarto, attach it
if (!is.null(python)) {
manifest$python <- python
}
# if there are no packages set manifest$packages to NA (json null)
if (length(packages) > 0) {
manifest$packages <- I(packages)
} else {
manifest$packages <- NA
}
# if there are no files, set manifest$files to NA (json null)
if (length(files) > 0) {
manifest$files <- I(filelist)
} else {
manifest$files <- NA
}
# if there are no users set manifest$users to NA (json null)
if (length(users) > 0) {
manifest$users <- I(userlist)
} else {
manifest$users <- NA
}
manifest
}
rsconnect/R/configureApp.R 0000644 0001762 0000144 00000013461 14515740414 015230 0 ustar ligges users #' Configure an Application
#'
#' Configure an application running on a remote server.
#'
#' @inheritParams deployApp
#'
#' @param appName Name of application to configure
#' @param appDir Directory containing application. Defaults to
#' current working directory.
#' @inheritParams deployApp
#' @param redeploy Re-deploy application after its been configured.
#' @param size Configure application instance size
#' @param instances Configure number of application instances
#' @examples
#' \dontrun{
#'
#' # set instance size for an application
#' configureApp("myapp", size="xlarge")
#' }
#' @seealso [applications()], [deployApp()]
#' @note This function works only for ShinyApps servers.
#' @export
configureApp <- function(appName, appDir = getwd(), account = NULL, server = NULL,
redeploy = TRUE, size = NULL,
instances = NULL, logLevel = c("normal", "quiet", "verbose")) {
accountDetails <- accountInfo(account, server)
checkShinyappsServer(accountDetails$server)
if (is.null(appName))
appName <- basename(appDir)
application <- resolveApplication(accountDetails, appName)
displayStatus <- displayStatus(identical(logLevel, "quiet"))
# some properties may required a rebuild to take effect
rebuildRequired <- FALSE
# get a list of properties to set
properties <- list()
if (! is.null(size)) {
properties[["application.instances.template"]] <- size
}
if (! is.null(instances)) {
properties[["application.instances.count"]] <- instances
}
# set application properties
client <- clientForAccount(accountDetails)
for (i in names(properties)) {
propertyName <- i
propertyValue <- properties[[i]]
# dispatch to the appropriate client implementation
if (is.function(client$configureApplication))
client$configureApplication(application$id, propertyName, propertyValue)
else if (is.function(client$setApplicationProperty))
client$setApplicationProperty(application$id, propertyName, propertyValue)
else
stop("Server ", accountDetails$server, " has no appropriate configuration method.")
}
# redeploy application if requested
if (redeploy) {
if (length(properties) > 0) {
deployApp(appDir = appDir, appName = appName, account = account, logLevel = logLevel, upload = rebuildRequired)
}
else
{
displayStatus("No configuration changes to deploy")
}
}
}
#' Set Application property
#'
#' Set a property on currently deployed ShinyApps application.
#'
#' @param propertyName Name of property
#' @param propertyValue Property value
#' @param appName Name of application
#' @param appPath Directory or file that was deployed. Defaults to current
#' working directory.
#' @inheritParams deployApp
#' @param force Forcibly set the property
#'
#' @note This function only works for ShinyApps servers.
#'
#' @examples
#' \dontrun{
#'
#' # set instance size for an application
#' setProperty("application.instances.count", 1)
#'
#' # disable application package cache
#' setProperty("application.package.cache", FALSE)
#'
#' }
#' @export
setProperty <- function(propertyName, propertyValue, appPath = getwd(),
appName = NULL, account = NULL, server = NULL, force = FALSE) {
deployment <- findDeployment(
appPath = appPath,
appName = appName,
server = server,
account = account
)
accountDetails <- accountInfo(deployment$account, deployment$server)
checkShinyappsServer(accountDetails$server)
client <- clientForAccount(accountDetails)
application <- getAppByName(client, accountDetails, deployment$name)
invisible(client$setApplicationProperty(application$id,
propertyName,
propertyValue,
force))
}
#' Unset Application property
#'
#' Unset a property on currently deployed ShinyApps application (restoring to
#' its default value)
#'
#' @inheritParams setProperty
#' @param force Forcibly unset the property
#'
#' @note This function only works for ShinyApps servers.
#'
#' @examples
#' \dontrun{
#'
#' # unset application package cache property to revert to default
#' unsetProperty("application.package.cache")
#'
#' }
#' @export
unsetProperty <- function(propertyName, appPath = getwd(), appName = NULL,
account = NULL, server = NULL, force = FALSE) {
deployment <- findDeployment(
appPath = appPath,
appName = appName,
server = server,
account = account
)
accountDetails <- accountInfo(deployment$account, deployment$server)
checkShinyappsServer(accountDetails$server)
client <- clientForAccount(accountDetails)
application <- getAppByName(client, accountInfo, deployment$name)
invisible(client$unsetApplicationProperty(application$id,
propertyName,
force))
}
#' Show Application property
#'
#' Show properties of an application deployed to ShinyApps.
#'
#' @param appName Name of application
#' @param appPath Directory or file that was deployed. Defaults to current
#' working directory.
#' @inheritParams deployApp
#'
#' @note This function works only for ShinyApps servers.
#'
#' @export
showProperties <- function(appPath = getwd(), appName = NULL, account = NULL, server = NULL) {
deployment <- findDeployment(
appPath = appPath,
appName = appName,
account = account,
server = server
)
accountDetails <- accountInfo(deployment$account, deployment$server)
checkShinyappsServer(accountDetails$server)
client <- clientForAccount(accountDetails)
application <- getAppByName(client, accountDetails, deployment$name)
# convert to data frame
res <- do.call(rbind, application$deployment$properties)
df <- as.data.frame(res, stringsAsFactors = FALSE)
names(df) <- c("value")
return(df)
}
rsconnect/R/account-find.R 0000644 0001762 0000144 00000006420 14516247550 015161 0 ustar ligges users # Return a list containing the name and server associated with a matching account.
#
# Use `accountInfo()` and `findAccountInfo()` to load credentials associated with this account.
findAccount <- function(accountName = NULL, server = NULL, error_call = caller_env()) {
check_string(accountName, allow_null = TRUE, arg = "account", call = error_call)
check_string(server, allow_null = TRUE, call = error_call)
accounts <- accounts()
if (nrow(accounts) == 0) {
cli::cli_abort(
c(
"No accounts registered.",
i = "Call {.fun rsconnect::setAccountInfo} to register an account."
),
call = error_call
)
}
if (!is.null(accountName) && !is.null(server)) {
theseAccounts <- accounts[accounts$server == server & accounts$name == accountName, , drop = FALSE]
if (nrow(theseAccounts) == 0) {
cli::cli_abort(
c(
"Can't find account with {.arg name} = {.str {accountName}} and {.arg server} = {.str {server}}",
i = "Call {.fun accounts} to see available options."
),
call = error_call
)
}
} else if (is.null(accountName) && !is.null(server)) {
theseAccounts <- accounts[accounts$server == server, , drop = FALSE]
if (nrow(theseAccounts) == 0) {
cli::cli_abort(
c(
"Can't find any accounts with {.arg server} = {.str {server}}.",
i = "Known servers are {.str {unique(accounts$server)}}."
),
call = error_call
)
} else if (nrow(theseAccounts) > 1) {
cli::cli_abort(
c(
"Found multiple accounts for {.arg server} = {.str {server}}.",
"Please disambiguate by setting {.arg account}.",
i = "Known account names are {.str {theseAccounts$name}}."
),
call = error_call
)
}
} else if (!is.null(accountName) && is.null(server)) {
theseAccounts <- accounts[accounts$name == accountName, , drop = FALSE]
if (nrow(theseAccounts) == 0) {
cli::cli_abort(
c(
"Can't find any accounts with {.arg account} = {.str {accountName}}.",
i = "Available account names: {.str {unique(accounts$name)}}."
),
call = error_call
)
} else if (nrow(theseAccounts) > 1) {
cli::cli_abort(
c(
"Found multiple accounts for {.arg account} = {.str {accountName}}.",
"Please disambiguate by setting {.arg server}.",
i = "Available servers: {.str {theseAccounts$server}}."
),
call = error_call
)
}
} else {
theseAccounts <- accounts
if (nrow(theseAccounts) > 1) {
if (is_interactive()) {
labels <- accountLabel(accounts$name, accounts$server)
choice <- cli_menu(
"Found multiple accounts.",
"Which one do you want to use?",
labels
)
theseAccounts <- theseAccounts[choice, , drop = FALSE]
} else {
cli::cli_abort(
c(
"Found multiple accounts.",
"Please disambiguate by setting {.arg server} and/or {.arg account}.",
i = "Available servers: {.str {unique(theseAccounts$server)}}.",
i = "Available account names: {.str {unique(theseAccounts$name)}}."
),
call = error_call
)
}
}
}
as.list(theseAccounts)
}
rsconnect/R/deploySite.R 0000644 0001762 0000144 00000011144 14513230050 014707 0 ustar ligges users #' Deploy a website
#'
#' Deploy an R Markdown or quarto website to a server.
#'
#' @inheritParams deployApp
#' @param siteDir Directory containing website. Defaults to current directory.
#' @param siteName Name for the site (names must be unique within
#' an account). Defaults to the base name of the specified `siteDir`
#' or to the name provided by a custom site generation function.
#' @param siteTitle Title for the site. For quarto sites only, if not
#' supplied uses the title recorded in `_quarto.yml`.
#' @param render Rendering behavior for site:
#'
#' * `"none"` uploads a static version of the current contents of
#' the site directory.
#' * `"local"` renders the site locally then uploads it.
#' * `"server"` uploads the source of the site to render on the server.
#'
#' Note that for `"none"` and `"local"` source files (e.g. `.R`, `.Rmd` and
#' `.md`) will not be uploaded to the server.
#' @param recordDir The default, `NULL`, uses `siteDir`.
#' @param ... Additional arguments to [deployApp()]. Do not supply `appDir`
#' or `appFiles`; these parameters are automatically generated by
#' `deploySite()`.
#' @family Deployment functions
#' @export
deploySite <- function(siteDir = getwd(),
siteName = NULL,
siteTitle = NULL,
account = NULL,
server = NULL,
render = c("none", "local", "server"),
launch.browser = getOption("rsconnect.launch.browser", interactive()),
logLevel = c("normal", "quiet", "verbose"),
lint = FALSE,
metadata = list(),
python = NULL,
recordDir = NULL,
...) {
check_directory(siteDir)
isQuarto <- file.exists(file.path(siteDir, "_quarto.yml")) ||
file.exists(file.path(siteDir, "_quarto.yaml"))
quiet <- identical(match.arg(logLevel), "quiet")
if (isQuarto) {
site <- quartoSite(siteDir, quiet = quiet)
} else {
site <- rmarkdownSite(siteDir, quiet = quiet)
}
# render locally if requested
render <- arg_match(render)
if (render == "local") {
site$render()
}
# determine appDir based on whether we are rendering on the server
if (render == "server") {
appDir <- siteDir
} else {
appDir <- site$output_dir
}
# Need to override recordDir to always record in the source directory
if (is.null(recordDir)) {
# We're deploying an entire directory, so we don't really need to set
# a path here, but we don't want to break existing deployments so
# we leave the existing behaviour for RMarkdown
if (!isQuarto) {
name <- if (file.exists("index.Rmd")) "index.Rmd" else "index.md"
recordDir <- file.path(siteDir, name)
} else {
recordDir <- siteDir
}
}
deployApp(
appName = siteName %||% site$name,
appTitle = siteTitle %||% site$title,
appDir = appDir,
recordDir = recordDir,
contentCategory = "site",
account = account,
server = server,
launch.browser = launch.browser,
logLevel = logLevel,
lint = lint,
metadata = metadata,
python = python,
...
)
}
quartoSite <- function(path, quiet = FALSE, error_call = caller_env()) {
check_installed(
"quarto",
reason = "to deploy quarto sites",
call = error_call
)
config <- quarto::quarto_inspect(path)$config
list(
render = function() quarto::quarto_render(path, quiet = quiet, as_job = FALSE),
name = basename(normalizePath(path)),
title = config$website$title %||% config$book$title %||% config$title,
# non-site projects build in current directory
output_dir = outputDir(path, config$project$`output-dir` %||% ".")
)
}
rmarkdownSite <- function(siteDir, quiet = FALSE, error_call = caller_env()) {
check_installed(
"rmarkdown",
version = "0.9.5.3",
reason = "to deploy RMarkdown sites",
call = error_call
)
# discover the site generator
siteGenerator <- rmarkdown::site_generator(siteDir)
if (is.null(siteGenerator)) {
cli::cli_abort(
"No `_site.yml` found in {.path {siteDir}.}",
call = error_call
)
}
list(
render = function() {
siteGenerator$render(
input_file = NULL,
output_format = NULL,
envir = new.env(),
quiet = quiet,
encoding = getOption("encoding")
)
},
name = siteGenerator$name,
title = NULL,
output_dir = outputDir(siteDir, siteGenerator$output_dir)
)
}
outputDir <- function(wd, path) {
old <- setwd(wd)
defer(setwd(old))
normalizePath(dirCreate(path), mustWork = FALSE)
}
rsconnect/R/client.R 0000644 0001762 0000144 00000010606 14513230050 014046 0 ustar ligges users clientForAccount <- function(account) {
serverInfo <- serverInfo(account$server)
account$certificate <- serverInfo$certificate
serverUrl <- parseHttpUrl(serverInfo$url)
if (isShinyappsServer(account$server)) {
shinyAppsClient(serverUrl, account)
} else if (isPositCloudServer(account$server)) {
cloudClient(serverUrl, account)
} else {
connectClient(serverUrl, account)
}
}
# Appropriate when the list API includes "count" and "total" fields in the response JSON and the API
# supports pagination with the query arguments count=PAGE_SIZE&offset=STARTING_POINT.
listRequest <- function(service, authInfo, path, query, listName, page = 100,
max = NULL) {
# accumulate multiple pages of results
offset <- 0
results <- list()
repeat {
# add query params
queryWithList <- paste(query, "&count=", page, "&offset=", offset, sep = "")
# make request and append the results
response <- GET(service, authInfo, path, queryWithList)
results <- append(results, response[[listName]])
# update the offset
offset <- offset + response$count
# get all results if no max was specified
if (is.null(max)) {
max <- response$total
}
# exit if we've got them all
if (length(results) >= response$total || length(results) >= max)
break
}
return(results)
}
# /__api__/applications response with { applications: [], count: M, total: N, continuation: "CONTINUATION" }
# To paginate, use the query arguments cont=CONTINUATION&start=START&count=MAX
listApplicationsRequest <- function(service, authInfo, path, query, listName, page = 100,
max = NULL) {
# accumulate multiple pages of results
start <- 0
cont <- ""
results <- list()
repeat {
# add query params
queryWithList <- paste(query,
"&count=", page,
"&start=", start,
"&cont=", cont,
sep = "")
# make request and append the results
response <- GET(service, authInfo, path, queryWithList)
results <- append(results, response[[listName]])
# update the starting point for the next request
start <- start + response$count
cont <- response$continuation
# get all results if no max was specified
if (is.null(max)) {
max <- response$total
}
# exit if we've got them all
if (length(results) >= response$total || length(results) >= max)
break
}
return(results)
}
filterQuery <- function(param, value, operator = NULL) {
if (is.null(operator)) {
op <- ":"
} else {
op <- paste(":", operator, ":", sep = "")
}
q <- paste("filter=", param, op, value, sep = "")
return(q)
}
isContentType <- function(x, contentType) {
grepl(contentType, x, fixed = TRUE)
}
uploadCloudBundle <- function(client,
application_id,
bundlePath,
verbose = FALSE) {
# Step 1. Create presigned URL and register pending bundle.
bundleSize <- file.info(bundlePath)$size
bundle <- client$createBundle(
application_id,
content_type = "application/x-tar",
content_length = bundleSize,
checksum = fileMD5(bundlePath)
)
# Step 2. Upload Bundle to presigned URL
logger <- verboseLogger(verbose)
logger("Starting upload now")
if (!uploadBundle(bundle, bundleSize, bundlePath)) {
stop("Could not upload file.")
}
logger("Upload complete")
# Step 3. Upload revise bundle status.
response <- client$updateBundleStatus(bundle$id, status = "ready")
# Step 4. Retrieve updated bundle post status change
client$getBundle(bundle$id)
}
uploadBundle <- function(bundle, bundleSize, bundlePath) {
presigned_service <- parseHttpUrl(bundle$presigned_url)
headers <- list()
headers$`Content-Type` <- "application/x-tar"
headers$`Content-Length` <- bundleSize
# AWS requires a base64 encoded hash
headers$`Content-MD5` <- bundle$presigned_checksum
# AWS seems very sensitive to additional headers (likely becauseit was not included and signed
# for when the presigned link was created). So the lower level library is used here.
http <- httpFunction()
response <- http(
presigned_service$protocol,
presigned_service$host,
presigned_service$port,
"PUT",
presigned_service$path,
headers,
headers$`Content-Type`,
bundlePath
)
response$status == 200
}
rsconnect/R/rpubs.R 0000644 0001762 0000144 00000013437 14513230050 013730 0 ustar ligges users #' Upload a file to RPubs
#'
#' This function publishes a file to rpubs.com. If the upload succeeds a
#' list that includes an `id` and `continueUrl` is returned. A browser
#' should be opened to the `continueUrl` to complete publishing of the
#' document. If an error occurs then a diagnostic message is returned in the
#' `error` element of the list.
#'
#' @param title The title of the document.
#' @param contentFile The path to the content file to upload.
#' @param originalDoc The document that was rendered to produce the
#' `contentFile`. May be `NULL` if the document is not known.
#' @param id If this upload is an update of an existing document then the id
#' parameter should specify the document id to update. Note that the id is
#' provided as an element of the list returned by successful calls to
#' `rpubsUpload`.
#' @param properties A named list containing additional document properties
#' (RPubs doesn't currently expect any additional properties, this parameter
#' is reserved for future use).
#'
#' @return A named list. If the upload was successful then the list contains a
#' `id` element that can be used to subsequently update the document as
#' well as a `continueUrl` element that provides a URL that a browser
#' should be opened to in order to complete publishing of the document. If the
#' upload fails then the list contains an `error` element which contains
#' an explanation of the error that occurred.
#'
#' @examples
#' \dontrun{
#' # upload a document
#' result <- rpubsUpload("My document title", "Document.html")
#' if (!is.null(result$continueUrl))
#' browseURL(result$continueUrl)
#' else
#' stop(result$error)
#'
#' # update the same document with a new title
#' updateResult <- rpubsUpload("My updated title", "Document.html",
#' id = result$id)
#' }
#' @export
rpubsUpload <- function(title,
contentFile,
originalDoc,
id = NULL,
properties = list()) {
check_string(title, allow_empty = FALSE)
check_file(contentFile)
if (!is.list(properties))
stop("properties paramater must be a named list")
pathFromId <- function(id) {
split <- strsplit(id, "^https?://[^/]+")[[1]]
if (length(split) == 2)
return(split[2])
else
return(NULL)
}
buildPackage <- function(title,
contentFile,
properties = list()) {
# build package.json
properties$title <- title
packageJson <- toJSON(properties)
# create a tempdir to build the package in and copy the files to it
fileSep <- .Platform$file.sep
packageDir <- dirCreate(tempfile())
packageFile <- function(fileName) {
paste(packageDir, fileName, sep = fileSep)
}
writeLines(packageJson, packageFile("package.json"))
file.copy(contentFile, packageFile("index.html"))
# create the tarball
tarfile <- tempfile("package", fileext = ".tar.gz")
writeBundle(packageDir, tarfile)
# return the full path to the tarball
return(tarfile)
}
# build the package
packageFile <- buildPackage(title, contentFile, properties)
# determine whether this is a new doc or an update
isUpdate <- FALSE
method <- "POST"
path <- "/api/v1/document"
headers <- list()
headers$Connection <- "close"
if (!is.null(id)) {
isUpdate <- TRUE
path <- pathFromId(id)
method <- "PUT"
}
# use https if using a curl R package, and vanilla HTTP otherwise
http <- httpFunction()
if (identical(http, httpRCurl) || identical(http, httpLibCurl)) {
protocol <- "https"
port <- 443
} else {
protocol <- "http"
port <- 80
}
# send the request
result <- http(protocol = protocol,
host = "api.rpubs.com",
port = port,
method = method,
path = path,
headers = headers,
contentType = "application/x-compressed",
contentFile = packageFile)
# check for success
succeeded <- FALSE
if (isUpdate && (result$status == 200))
succeeded <- TRUE
else if (result$status == 201)
succeeded <- TRUE
# mark content as UTF-8
content <- result$content
Encoding(content) <- "UTF-8"
# return either id & continueUrl or error
if (succeeded) {
parsedContent <- jsonlite::fromJSON(content)
id <- ifelse(isUpdate, id, result$location)
url <- as.character(parsedContent["continueUrl"])
# we use the source doc as the key for the deployment record as long as
# it's a recognized document path; otherwise we use the content file
recordSource <- ifelse(!is.null(originalDoc) && isDocumentPath(originalDoc),
originalDoc, contentFile)
# use the title if given, and the filename name of the document if not
recordName <- ifelse(is.null(title) || nchar(title) == 0,
basename(recordSource), title)
rpubsRec <- deploymentRecord(name = recordName,
title = "",
username = "",
account = "rpubs",
server = "rpubs.com",
hostUrl = "rpubs.com",
appId = id,
bundleId = id,
url = url)
rpubsRecFile <- deploymentConfigFile(recordSource, recordName, "rpubs",
"rpubs.com")
write.dcf(rpubsRec, rpubsRecFile, width = 4096)
# record in global history
if (!is.null(originalDoc) && nzchar(originalDoc))
addToDeploymentHistory(originalDoc, rpubsRec)
# return the publish information
return(list(id = id,
continueUrl = url))
} else {
return(list(error = content))
}
}
rsconnect/R/linters.R 0000644 0001762 0000144 00000021744 14513230050 014255 0 ustar ligges users .__LINTERS__. <- new.env(parent = emptyenv())
##' Add a Linter
##'
##' Add a linter, to be used in subsequent calls to [lint()].
##'
##' @param name The name of the linter, as a string.
##' @param linter A [linter()].
##' @export
##' @example examples/example-linter.R
addLinter <- function(name, linter) {
assign(name, linter, envir = .__LINTERS__.)
}
##' Create a Linter
##'
##' Generate a linter, which can identify errors or problematic regions in a
##' project.
##'
##' @param apply Function that, given the content of a file, returns the indices
##' at which problems were found.
##' @param takes Function that, given a set of paths, returns the subset of
##' paths that this linter uses.
##' @param message Function that, given content and lines, returns an
##' informative message for the user. Typically generated with
##' [makeLinterMessage()].
##' @param suggestion String giving a prescribed fix for the linted problem.
##' @export
##' @example examples/example-linter.R
linter <- function(apply, takes, message, suggestion) {
result <- list(
apply = apply,
takes = takes,
message = message,
suggestion = suggestion
)
class(result) <- "linter"
result
}
getLinterApplicableFiles <- function(linter, files) {
result <- linter$takes(files)
if (is.numeric(result) || is.logical(result)) {
files[result]
} else {
result
}
}
applyLinter <- function(linter, ...) {
result <- linter$apply(...)
if (is.logical(result)) {
output <- which(result)
} else {
output <- as.numeric(result)
}
attributes(output) <- attributes(result)
output
}
isRCodeFile <- function(path) {
grepl("\\.[rR]$|\\.[rR]md$|\\.[rR]nw$", path)
}
addLinter("absolute.paths", linter(
apply = function(content, ...) {
content <- stripComments(content)
which(hasAbsolutePaths(content))
},
takes = isRCodeFile,
message = function(content, lines) {
makeLinterMessage("The following lines contain absolute paths",
content,
lines)
},
suggestion = "Paths should be to files within the project directory."
))
addLinter("filepath.capitalization", linter(
apply = function(content, project, path, files) {
content <- stripComments(content)
# Extract references between bounding (unescaped) quotes.
extractQuoted <- function(regex) {
matches <- gregexpr(regex, content, perl = TRUE)
results <- vector("list", length(content))
for (i in seq_along(matches)) {
x <- matches[[i]]
if (x[[1]] == -1L || length(x) %% 2 != 0) next
starts <- x[seq(1, length(x), by = 2)]
ends <- x[seq(2, length(x), by = 2)]
results[[i]] <- character(length(starts))
for (j in seq_along(starts)) {
results[[i]][[j]] <- substring(content[i], starts[j] + 1, ends[j] - 1)
}
}
results
}
# Extract targets from Markdown links.
extractLinked <- function() {
regex <- "\\]\\(.*?\\)"
matches <- gregexpr(regex, content, perl = TRUE)
results <- vector("list", length(content))
for (i in seq_along(matches)) {
x <- matches[[i]]
if (x[[1]] == -1L) next
results[[i]] <- character(length(x))
attr <- attributes(x)
for (j in seq_along(x)) {
raw <- x[[j]]
raw.length <- attr$match.length[[j]]
# skip past "](" and discard ")"
start <- as.integer(raw) + 2
end <- as.integer(raw) + raw.length - 2
results[[i]][[j]] <- substring(content[i], start, end)
}
}
results
}
# Inferred files within source documents; between matching quotes or in
# something that looks like a Markdown link.
inferredFiles <- list(
"single.quotes" = extractQuoted("(?!\\\\)\'"),
"double.quotes" = extractQuoted("(?!\\\\)\""),
"markdown.links" = extractLinked()
)
## Replace '\' with '/' in filepaths for consistency in comparisons
inferredFiles <- lapply(inferredFiles, function(x) {
lapply(x, function(xx) {
gsub("\\\\", "/", xx, perl = TRUE)
})
})
# Compare in case sensitive, case insensitive fashion
projectFiles <- files
projectFilesLower <- tolower(files)
badLines <- lapply(inferredFiles, function(regex) {
lapply(regex, function(x) {
which(
# Only examine paths containing a slash to reduce false positives
grepl("/", x, fixed = TRUE) &
(tolower(x) %in% projectFilesLower) &
(!(x %in% projectFiles))
)
})
})
indices <- Reduce(union, lapply(badLines, function(x) {
which(sapply(x, length) > 0)
}))
if (!length(indices)) return(integer())
from <- lapply(inferredFiles, function(x) x[indices])
to <- lapply(from, function(x) {
lapply(x, function(xx) {
projectFiles[tolower(xx) == projectFilesLower]
})
})
messages <- lapply(seq_along(from), function(regex) {
lapply(seq_along(regex), function(i) {
if (length(from[[regex]][[i]]))
paste(collapse = ", ",
paste("[",
sQuote(from[[regex]][[i]]),
" -> ",
sQuote(to[[regex]][[i]]),
"]", sep = "")
)
else
""
})
})
transposed <- transposeList(messages)
lint <- sapply(transposed, function(x) {
paste(x[x != ""], collapse = ", ")
})
indices <- as.numeric(indices)
attr(indices, "lint") <- lint
indices
},
takes = isRCodeFile,
message = function(content, lines) {
makeLinterMessage(
"The following lines contain paths to files not matching in case sensitivity",
content,
lines
)
},
suggestion = "Filepaths are case-sensitive on deployment server."
))
addLinter("browser", linter(
apply = function(content, ...) {
content <- stripComments(content)
which(hasBrowserCalls(content))
},
takes = isRCodeFile,
message = function(content, lines) {
makeLinterMessage("The following lines contain the browser() debugging function",
content,
lines)
},
suggestion = "The browser() debugging function should be removed."
))
addLinter("browseURL", linter(
apply = function(content, ...) {
content <- stripComments(content)
which(hasBrowseURLCalls(content))
},
takes = isRCodeFile,
message = function(content, lines) {
makeLinterMessage("The following lines contain calls to the browseURL function",
content,
lines)
},
suggestion = "Remove browseURL calls; browseURL does not work in deployed applications."
))
stripComments <- function(content) {
gsub("#.*", "", content, perl = TRUE)
}
hasBrowserCalls <- function(content) {
# look for calls to browser(); they will cause a debug halt, which is almost
# never wanted in a production application
grepl("\\bbrowser\\([^)]*\\)", content, perl = TRUE)
}
hasBrowseURLCalls <- function(content) {
# look for calls to browseURL(); browsers can't be opened on the server in
# deployed applications
grepl("\\bbrowseURL\\([^)]*\\)", content, perl = TRUE)
}
hasAbsolutePaths <- function(content) {
regex <- c(
"\\[(.*?)\\]\\(\\s*[a-zA-Z]:/[^\"\']", ## windows-style markdown references [Some image](C:/...)
"\\[(.*?)\\]\\(\\s*/[^/]", ## unix-style markdown references [Some image](/Users/...)
NULL ## so we don't worry about commas above
)
regexResults <- as.logical(Reduce(`+`, lapply(regex, function(rex) {
grepl(rex, content, perl = TRUE)
})))
# Strip out all strings in the document, and check to see if any of them
# resolve to absolute paths on the system.
sQuoteRegex <- "['](?:(?:\\\\.)|(?:[^'\\\\]))*?[']"
dQuoteRegex <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]'
extractedStrings <- lapply(c(sQuoteRegex, dQuoteRegex), function(regex) {
matches <- gregexpr(regex, content, perl = TRUE)
lapply(seq_along(matches), function(i) {
match <- matches[[i]]
if (c(match[[1]]) == -1L) return(character())
starts <- as.integer(match) + 1
ends <- starts + attr(match, "match.length") - 3
substring(content[[i]], starts, ends)
})
})
strings <- vector("list", length(extractedStrings[[1]]))
for (i in seq_along(extractedStrings[[1]])) {
strings[[i]] <- unique(c(extractedStrings[[1]][[i]], extractedStrings[[2]][[i]]))
strings[[i]] <- strings[[i]][nchar(strings[[i]]) >= 5]
}
lineHasAbsolutePath <- unlist(lapply(strings, function(x) {
any(
grepl("^/|^[a-zA-Z]:/|^~", x, perl = TRUE) &
file.exists(x) &
!dirExists(x) &
vapply(gregexpr("[~/]", x, perl = TRUE), USE.NAMES = FALSE, FUN.VALUE = numeric(1), length) >= 3
)
}))
as.logical(lineHasAbsolutePath + regexResults)
}
noMatch <- function(x) {
identical(attr(x, "match.length"), -1L)
}
transposeList <- function(list) {
unname(as.list(
as.data.frame(
t(
as.matrix(
as.data.frame(list, stringsAsFactors = FALSE)
)
), stringsAsFactors = FALSE)
))
}
rsconnect/R/locale.R 0000644 0001762 0000144 00000001323 14513230050 014023 0 ustar ligges users detectLocale <- function() {
if (!isWindows()) {
locales <- strsplit(Sys.getlocale("LC_CTYPE"), ".", fixed = TRUE)[[1]]
locales[[1]]
} else {
tryCatch(windowsLocale(), error = function(err) "en_US")
}
}
# Possible values
# listed at https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-lcid
windowsLocale <- function() {
key <- utils::readRegistry("Control Panel\\International", hive = "HCU")
normalizeLocale(key$LocaleName)
}
# Remove script tag, if present
normalizeLocale <- function(x) {
pieces <- strsplit(x, "-")[[1]]
all_upper <- pieces[pieces == toupper(pieces)]
if (length(all_upper) == 0) {
pieces[[1]]
} else {
paste0(pieces[[1]], "_", all_upper[[1]])
}
}
rsconnect/R/bundlePython.R 0000644 0001762 0000144 00000006116 14513230050 015244 0 ustar ligges users # Create anonymous function that we can later call to get all needed python
# metdata for the manifest
pythonConfigurator <- function(python,
forceGenerate = FALSE) {
if (is.null(python)) {
return(NULL)
}
force(forceGenerate)
function(appDir) {
withCallingHandlers(
inferPythonEnv(
appDir,
python = python,
forceGenerate = forceGenerate
),
error = function(err) {
cli::cli_abort(
"Failed to detect python environment",
parent = err
)
}
)
}
}
# python is enabled on Connect and posit.cloud, but not on Shinyapps
getPythonForTarget <- function(path, accountDetails) {
targetIsShinyapps <- isShinyappsServer(accountDetails$server)
pythonEnabled <- getOption("rsconnect.python.enabled", !targetIsShinyapps)
if (pythonEnabled) {
getPython(path)
} else {
NULL
}
}
getPython <- function(path = NULL) {
if (!is.null(path)) {
return(path.expand(path))
}
path <- Sys.getenv("RETICULATE_PYTHON")
if (path != "") {
return(path.expand(path))
}
path <- Sys.getenv("RETICULATE_PYTHON_FALLBACK")
if (path != "") {
return(path.expand(path))
}
NULL
}
inferPythonEnv <- function(workdir,
python = getPython(),
forceGenerate = FALSE) {
# run the python introspection script
env_py <- system.file("resources/environment.py", package = "rsconnect")
args <- c(
shQuote(env_py),
if (forceGenerate) "-f",
shQuote(workdir)
)
hasConda <- is_installed("reticulate") &&
reticulate::py_available(initialize = FALSE) &&
reticulate::py_config()$anaconda
if (hasConda) {
prefix <- getCondaEnvPrefix(python)
conda <- getCondaExeForPrefix(prefix)
args <- c("run", "-p", prefix, python, args)
# conda run -p python inst/resources/environment.py
output <- system2(command = conda, args = args, stdout = TRUE, stderr = NULL, wait = TRUE)
} else {
output <- system2(command = python, args = args, stdout = TRUE, stderr = NULL, wait = TRUE)
}
environment <- jsonlite::fromJSON(output)
if (is.null(environment$error)) {
list(
version = environment$python,
package_manager = list(
name = environment$package_manager,
version = environment[[environment$package_manager]],
package_file = environment$filename,
contents = environment$contents
)
)
} else {
cli::cli_abort(environment$error)
}
}
getCondaEnvPrefix <- function(python) {
prefix <- dirname(dirname(python))
if (!file.exists(file.path(prefix, "conda-meta"))) {
stop(paste("Python from", python, "does not look like a conda environment: cannot find `conda-meta`"))
}
prefix
}
getCondaExeForPrefix <- function(prefix) {
miniconda <- dirname(dirname(prefix))
conda <- file.path(miniconda, "bin", "conda")
if (isWindows()) {
conda <- paste(conda, ".exe", sep = "")
}
if (!file.exists(conda)) {
stop(paste("Conda env prefix", prefix, "does not have the `conda` command line interface."))
}
conda
}
rsconnect/R/http-rcurl.R 0000644 0001762 0000144 00000013306 14435652570 014716 0 ustar ligges users # HTTP transport using the RCurl package. DEPRECATED; exists only for backwards compatibility (it
# was the default transport for many years). In a future release of rsconnect, the RCurl transport
# will be removed entirely, and the "rcurl" option will be interpreted as "libcurl".
httpRCurl <- function(protocol,
host,
port,
method,
path,
headers,
contentType = NULL,
contentFile = NULL,
certificate = NULL,
timeout = NULL) {
if (!is.null(contentFile) && is.null(contentType))
stop("You must specify a contentType for the specified file")
# add prefix to port if necessary
if (!is.null(port) && nzchar(port))
port <- paste(":", port, sep = "")
# build url
url <- paste(protocol, "://", host, port, path, sep = "")
# read file in binary mode
if (!is.null(contentFile)) {
fileLength <- file.info(contentFile)$size
fileContents <- readBin(contentFile, what = "raw", n = fileLength)
headers$`Content-Type` <- contentType
}
# establish options
options <- RCurl::curlOptions(url)
options$useragent <- userAgent()
# overlay user-supplied options
userOptions <- getOption("rsconnect.rcurl.options")
if (is.list(userOptions)) {
for (option in names(userOptions)) {
options[option] <- userOptions[option]
}
}
if (isTRUE(getOption("rsconnect.check.certificate", TRUE))) {
options$ssl.verifypeer <- TRUE
# apply certificate information if present
if (!is.null(certificate))
options$cainfo <- certificate
} else {
# don't verify peer (less secure but tolerant to self-signed cert issues)
options$ssl.verifypeer <- FALSE
}
headerGatherer <- RCurl::basicHeaderGatherer()
options$headerfunction <- headerGatherer$update
# the text processing done by .mapUnicode has the unfortunate side effect
# of turning escaped backslashes into ordinary backslashes but leaving
# ordinary backslashes alone, which can create malformed JSON.
textGatherer <- RCurl::basicTextGatherer(.mapUnicode = FALSE)
# use timeout if supplied
if (!is.null(timeout)) {
options$timeout <- timeout
}
# verbose if requested
if (httpVerbose())
options$verbose <- TRUE
# add extra headers
headers <- appendCookieHeaders(
list(protocol = protocol, host = host, port = port, path = path), headers)
extraHeaders <- as.character(headers)
names(extraHeaders) <- names(headers)
options$httpheader <- extraHeaders
# make the request
time <- system.time(gcFirst = FALSE, tryCatch({
if (!is.null(contentFile)) {
RCurl::curlPerform(url = url,
.opts = options,
customrequest = method,
readfunction = fileContents,
infilesize = fileLength,
writefunction = textGatherer$update,
upload = TRUE)
} else if (method == "DELETE") {
RCurl::curlPerform(url = url,
.opts = options,
customrequest = method)
} else {
if (identical(method, "GET")) {
RCurl::getURL(url,
.opts = options,
write = textGatherer)
} else {
RCurl::curlPerform(url = url,
.opts = options,
customrequest = method,
writefunction = textGatherer$update)
}
}},
error = function(e, ...) {
# ignore errors resulting from timeout or user abort
if (identical(e$message, "Callback aborted") ||
identical(e$message, "transfer closed with outstanding read data remaining"))
return(NULL)
# bubble remaining errors through
else
stop(e)
}))
httpTrace(method, path, time)
# get list of HTTP response headers
headers <- headerGatherer$value()
# deduce status. we do this *before* lowercase conversion, as it is possible
# for both "Status" and "status" headers to exist
status <- 200
statuses <- headers[names(headers) == "status"] # find status header
statuses <- statuses[grepl("^\\d+$", statuses)] # ensure fully numeric
if (length(statuses) > 0) {
# we found a numeric status header
status <- as.integer(statuses[[1]])
}
# lowercase all header names for normalization; HTTP/2 uses lowercase headers
# by default but they're typically capitalized in HTTP/1
names(headers) <- tolower(names(headers))
if ("location" %in% names(headers))
location <- headers[["location"]]
else
location <- NULL
# presume a plain text response unless specified otherwise
contentType <- if ("content-type" %in% names(headers)) {
headers[["content-type"]]
} else {
"text/plain"
}
# emit JSON trace if requested
if (!is.null(contentFile) && httpTraceJson() &&
identical(contentType, "application/json"))
cat(paste0("<< ", rawToChar(fileContents), "\n"))
# Parse cookies from header; bear in mind that there may be multiple headers
cookieHeaders <- headers[names(headers) == "set-cookie"]
storeCookies(list(protocol = protocol, host = host, port = port, path = path), cookieHeaders)
contentValue <- textGatherer$value()
# emit JSON trace if requested
if (httpTraceJson() && identical(contentType, "application/json"))
cat(paste0(">> ", contentValue, "\n"))
list(req = list(protocol = protocol,
host = host,
port = port,
method = method,
path = path),
status = status,
location = location,
contentType = contentType,
content = contentValue)
}
rsconnect/R/lint.R 0000644 0001762 0000144 00000016556 14513230050 013550 0 ustar ligges users ##' Lint a Project
##'
##' Takes the set of active linters (see [addLinter()]), and applies
##' them to all files within a project.
##'
##' @param project Path to a project directory.
##' @param files Specific files to lint. Can be NULL, in which case all
##' the files in the directory will be linted.
##' @param appPrimaryDoc The primary file in the project directory. Can be NULL,
##' in which case it's inferred (if possible) from the directory contents.
##' @export
lint <- function(project, files = NULL, appPrimaryDoc = NULL) {
check_directory(project)
files <- listDeploymentFiles(project, files)
# Perform actions within the project directory (so relative paths are easily used)
owd <- getwd()
defer(setwd(owd))
setwd(project)
linters <- mget(objects(.__LINTERS__.), envir = .__LINTERS__.)
# Identify all files that will be read in by one or more linters
projectFilesToLint <- Reduce(union, lapply(linters, function(linter) {
getLinterApplicableFiles(linter, files)
}))
# Read in the files
encoding <- activeEncoding(project)
projectContent <- lapply(projectFilesToLint, function(file) {
# force native encoding (disable any potential internal conversion)
old <- options(encoding = "native.enc")
defer(options(old))
# read content with requested encoding
# TODO: may consider converting from native encoding to UTF-8 if appropriate
readLines(file, encoding = encoding, warn = FALSE)
})
names(projectContent) <- projectFilesToLint
lintResults <- vector("list", length(linters))
names(lintResults) <- names(linters)
## Apply each linter
for (i in seq_along(linters)) {
linter <- linters[[i]]
applicableFiles <- getLinterApplicableFiles(linter, projectFilesToLint)
lintIndices <- vector("list", length(applicableFiles))
names(lintIndices) <- applicableFiles
## Apply linter to each file
for (j in seq_along(applicableFiles)) {
file <- applicableFiles[[j]]
tryCatch(
expr = {
lintIndices[[j]] <- applyLinter(linter,
projectContent[[file]],
project = project,
path = file,
files = files)
},
error = function(e) {
message("Failed to lint file '", file, "'")
message("The linter failed with message:\n")
message(e$message)
lintIndices[[j]] <- numeric(0)
}
)
}
## Get the messages associated with each lint
lintMessages <- enumerate(lintIndices, function(x, i) {
if (length(x)) {
message <- linter$message
if (is.function(message)) {
linter$message(projectContent[[names(lintIndices)[i]]], x)
} else {
makeLinterMessage(message, projectContent[[names(lintIndices)[i]]], x)
}
} else {
character()
}
})
## Assign the result
lintResults[[i]] <- list(
files = applicableFiles,
indices = lintIndices,
message = lintMessages,
suggestion = linter$suggestion
)
}
## Get all of the linted files, and transform the results into a by-file format
lintedFiles <- Reduce(union, lapply(lintResults, function(x) {
names(x$indices)
}))
lintFields <- c("indices", "message")
fileResults <- lapply(lintedFiles, function(file) {
result <- lapply(lintResults, function(result) {
subResult <- lapply(lintFields, function(field) {
result[[field]][[file]]
})
names(subResult) <- lintFields
subResult$suggestion <- result$suggestion
subResult$file <- file
class(subResult) <- "lint"
subResult
})
class(result) <- "lintList"
result
})
names(fileResults) <- lintedFiles
class(fileResults) <- "linterResults"
fileResults
}
lintHeader <- function(file) {
dashSep <- paste(rep("-", nchar(file)), collapse = "")
header <- paste0(
dashSep, "\n",
file, "\n",
dashSep, "\n"
)
cat(paste(header, collapse = "\n"))
}
#' @export
print.linterResults <- function(x, ...) {
if (!hasLint(x)) {
cat("No problems found\n")
return(invisible(x))
}
lapply(x, printLintList, ...)
cat(paste(collectSuggestions(x), collapse = "\n"))
invisible(x)
}
printLintList <- function(x, ...) {
has_message <- vapply(x, function(x) length(x$message), integer(1))
if (!any(has_message)) {
return()
}
lintHeader(x[[1]]$file)
lapply(x, function(x) {
cat(paste(x$message, collapse = "\n"))
})
}
collectSuggestions <- function(fileResults) {
suggestions <- lapply(fileResults, function(fileResult) {
unlist(lapply(fileResult, function(lintInfo) {
if (length(lintInfo$indices) > 0) {
paste(as.character(lintInfo$suggestion), collapse = "\n")
}
}))
})
Reduce(union, suggestions)
}
showLintResults <- function(appDir, lintResults) {
if (!hasLint(lintResults)) {
return(invisible())
}
if (interactive()) {
# if enabled, show warnings in friendly marker tab in addition to
# printing to console
if (getOption("rsconnect.rstudio_source_markers", TRUE) &&
rstudioapi::hasFun("sourceMarkers"))
{
showRstudioSourceMarkers(appDir, lintResults)
}
}
message("The following potential problems were identified in the project files:\n")
print(lintResults)
if (interactive()) {
response <- readline("Do you want to proceed with deployment? [y/N]: ")
if (tolower(substring(response, 1, 1)) != "y") {
cli::cli_abort("Cancelling deployment.")
}
} else {
# message(
# "\nIf you believe these errors are spurious, run:\n\n",
# "\tdeployApp(lint = FALSE)\n\n",
# "to disable linting."
# )
message("If your code fails to run post-deployment, ",
"please double-check these messages.")
invisible()
}
}
#' Construct a Linter Message
#'
#' Pretty-prints a linter message. Primarily used as a helper
#' for constructing linter messages with [linter()].
#'
#' @param header A header message describing the linter.
#' @param content The content of the file that was linted.
#' @param lines The line numbers from `content` that contain lint.
makeLinterMessage <- function(header, content, lines) {
lint <- attr(lines, "lint")
c(
paste0(header, ":"),
paste(lines, ": ",
content[lines],
if (!is.null(lint)) paste(" ", lint, sep = ""),
sep = ""),
"\n"
)
}
enumerate <- function(X, FUN, ...) {
FUN <- match.fun(FUN)
result <- vector("list", length(X))
for (i in seq_along(X)) {
result[[i]] <- FUN(X[[i]], i, ...)
}
names(result) <- names(X)
result
}
hasLint <- function(x) {
any(unlist(lapply(x, function(x) {
lapply(x, function(x) {
length(x$indices) > 0
})
})))
}
activeEncoding <- function(project = getwd()) {
defaultEncoding <- getOption("encoding")
if (identical(defaultEncoding, "native.enc"))
defaultEncoding <- "unknown"
# attempt to locate .Rproj file
files <- list.files(project, full.names = TRUE)
rprojFile <- grep("\\.Rproj$", files, value = TRUE)
if (length(rprojFile) != 1)
return(defaultEncoding)
# read the file
contents <- readLines(rprojFile, warn = FALSE, encoding = "UTF-8")
encodingLine <- grep("^Encoding:", contents, value = TRUE)
if (length(encodingLine) != 1)
return(defaultEncoding)
# remove "Encoding:" prefix
sub("^Encoding:\\s*", "", encodingLine)
}
rsconnect/R/import-standalone-obj-type.R 0000644 0001762 0000144 00000020267 14513230050 017763 0 ustar ligges users # Standalone file: do not edit by hand
# Source:
# ----------------------------------------------------------------------
#
# ---
# repo: r-lib/rlang
# file: standalone-obj-type.R
# last-updated: 2022-10-04
# license: https://unlicense.org
# ---
#
# ## Changelog
#
# 2022-10-04:
# - `obj_type_friendly(value = TRUE)` now shows numeric scalars
# literally.
# - `stop_friendly_type()` now takes `show_value`, passed to
# `obj_type_friendly()` as the `value` argument.
#
# 2022-10-03:
# - Added `allow_na` and `allow_null` arguments.
# - `NULL` is now backticked.
# - Better friendly type for infinities and `NaN`.
#
# 2022-09-16:
# - Unprefixed usage of rlang functions with `rlang::` to
# avoid onLoad issues when called from rlang (#1482).
#
# 2022-08-11:
# - Prefixed usage of rlang functions with `rlang::`.
#
# 2022-06-22:
# - `friendly_type_of()` is now `obj_type_friendly()`.
# - Added `obj_type_oo()`.
#
# 2021-12-20:
# - Added support for scalar values and empty vectors.
# - Added `stop_input_type()`
#
# 2021-06-30:
# - Added support for missing arguments.
#
# 2021-04-19:
# - Added support for matrices and arrays (#141).
# - Added documentation.
# - Added changelog.
#
# nocov start
#' Return English-friendly type
#' @param x Any R object.
#' @param value Whether to describe the value of `x`. Special values
#' like `NA` or `""` are always described.
#' @param length Whether to mention the length of vectors and lists.
#' @return A string describing the type. Starts with an indefinite
#' article, e.g. "an integer vector".
#' @noRd
obj_type_friendly <- function(x, value = TRUE) {
if (is_missing(x)) {
return("absent")
}
if (is.object(x)) {
if (inherits(x, "quosure")) {
type <- "quosure"
} else {
type <- paste(class(x), collapse = "/")
}
return(sprintf("a <%s> object", type))
}
if (!is_vector(x)) {
return(.rlang_as_friendly_type(typeof(x)))
}
n_dim <- length(dim(x))
if (!n_dim) {
if (!is_list(x) && length(x) == 1) {
if (is_na(x)) {
return(switch(
typeof(x),
logical = "`NA`",
integer = "an integer `NA`",
double =
if (is.nan(x)) {
"`NaN`"
} else {
"a numeric `NA`"
},
complex = "a complex `NA`",
character = "a character `NA`",
.rlang_stop_unexpected_typeof(x)
))
}
show_infinites <- function(x) {
if (x > 0) {
"`Inf`"
} else {
"`-Inf`"
}
}
str_encode <- function(x, width = 30, ...) {
if (nchar(x) > width) {
x <- substr(x, 1, width - 3)
x <- paste0(x, "...")
}
encodeString(x, ...)
}
if (value) {
if (is.numeric(x) && is.infinite(x)) {
return(show_infinites(x))
}
if (is.numeric(x) || is.complex(x)) {
number <- as.character(round(x, 2))
what <- if (is.complex(x)) "the complex number" else "the number"
return(paste(what, number))
}
return(switch(
typeof(x),
logical = if (x) "`TRUE`" else "`FALSE`",
character = {
what <- if (nzchar(x)) "the string" else "the empty string"
paste(what, str_encode(x, quote = "\""))
},
raw = paste("the raw value", as.character(x)),
.rlang_stop_unexpected_typeof(x)
))
}
return(switch(
typeof(x),
logical = "a logical value",
integer = "an integer",
double = if (is.infinite(x)) show_infinites(x) else "a number",
complex = "a complex number",
character = if (nzchar(x)) "a string" else "\"\"",
raw = "a raw value",
.rlang_stop_unexpected_typeof(x)
))
}
if (length(x) == 0) {
return(switch(
typeof(x),
logical = "an empty logical vector",
integer = "an empty integer vector",
double = "an empty numeric vector",
complex = "an empty complex vector",
character = "an empty character vector",
raw = "an empty raw vector",
list = "an empty list",
.rlang_stop_unexpected_typeof(x)
))
}
}
vec_type_friendly(x)
}
vec_type_friendly <- function(x, length = FALSE) {
if (!is_vector(x)) {
abort("`x` must be a vector.")
}
type <- typeof(x)
n_dim <- length(dim(x))
add_length <- function(type) {
if (length && !n_dim) {
paste0(type, sprintf(" of length %s", length(x)))
} else {
type
}
}
if (type == "list") {
if (n_dim < 2) {
return(add_length("a list"))
} else if (is.data.frame(x)) {
return("a data frame")
} else if (n_dim == 2) {
return("a list matrix")
} else {
return("a list array")
}
}
type <- switch(
type,
logical = "a logical %s",
integer = "an integer %s",
numeric = ,
double = "a double %s",
complex = "a complex %s",
character = "a character %s",
raw = "a raw %s",
type = paste0("a ", type, " %s")
)
if (n_dim < 2) {
kind <- "vector"
} else if (n_dim == 2) {
kind <- "matrix"
} else {
kind <- "array"
}
out <- sprintf(type, kind)
if (n_dim >= 2) {
out
} else {
add_length(out)
}
}
.rlang_as_friendly_type <- function(type) {
switch(
type,
list = "a list",
NULL = "`NULL`",
environment = "an environment",
externalptr = "a pointer",
weakref = "a weak reference",
S4 = "an S4 object",
name = ,
symbol = "a symbol",
language = "a call",
pairlist = "a pairlist node",
expression = "an expression vector",
char = "an internal string",
promise = "an internal promise",
... = "an internal dots object",
any = "an internal `any` object",
bytecode = "an internal bytecode object",
primitive = ,
builtin = ,
special = "a primitive function",
closure = "a function",
type
)
}
.rlang_stop_unexpected_typeof <- function(x, call = caller_env()) {
abort(
sprintf("Unexpected type <%s>.", typeof(x)),
call = call
)
}
#' Return OO type
#' @param x Any R object.
#' @return One of `"bare"` (for non-OO objects), `"S3"`, `"S4"`,
#' `"R6"`, or `"R7"`.
#' @noRd
obj_type_oo <- function(x) {
if (!is.object(x)) {
return("bare")
}
class <- inherits(x, c("R6", "R7_object"), which = TRUE)
if (class[[1]]) {
"R6"
} else if (class[[2]]) {
"R7"
} else if (isS4(x)) {
"S4"
} else {
"S3"
}
}
#' @param x The object type which does not conform to `what`. Its
#' `obj_type_friendly()` is taken and mentioned in the error message.
#' @param what The friendly expected type as a string. Can be a
#' character vector of expected types, in which case the error
#' message mentions all of them in an "or" enumeration.
#' @param show_value Passed to `value` argument of `obj_type_friendly()`.
#' @param ... Arguments passed to [abort()].
#' @inheritParams args_error_context
#' @noRd
stop_input_type <- function(x,
what,
...,
allow_na = FALSE,
allow_null = FALSE,
show_value = TRUE,
arg = caller_arg(x),
call = caller_env()) {
# From standalone-cli.R
cli <- env_get_list(
nms = c("format_arg", "format_code"),
last = topenv(),
default = function(x) sprintf("`%s`", x),
inherit = TRUE
)
if (allow_na) {
what <- c(what, cli$format_code("NA"))
}
if (allow_null) {
what <- c(what, cli$format_code("NULL"))
}
if (length(what)) {
what <- oxford_comma(what)
}
message <- sprintf(
"%s must be %s, not %s.",
cli$format_arg(arg),
what,
obj_type_friendly(x, value = show_value)
)
abort(message, ..., call = call, arg = arg)
}
oxford_comma <- function(chr, sep = ", ", final = "or") {
n <- length(chr)
if (n < 2) {
return(chr)
}
head <- chr[seq_len(n - 1)]
last <- chr[n]
head <- paste(head, collapse = sep)
# Write a or b. But a, b, or c.
if (n > 2) {
paste0(head, sep, final, " ", last)
} else {
paste0(head, " ", final, " ", last)
}
}
# nocov end
rsconnect/R/appDependencies.R 0000644 0001762 0000144 00000014311 14513230050 015654 0 ustar ligges users #' Detect application dependencies
#'
#' @description
#' `appDependencies()` recursively detects all R package dependencies for an
#' application by parsing all `.R` and `.Rmd` files and looking for calls
#' to `library()`, `require()`, `requireNamespace()`, `::`, and so on.
#' It then adds implicit dependencies (i.e. an `.Rmd` requires Rmarkdown)
#' and adds all recursive dependencies to create a complete manifest of
#' package packages need to be installed to run the app.
#'
#' # Dependency discovery
#'
#' rsconnect use one of three mechanisms to find which packages your application
#' uses:
#'
#' 1. If `renv.lock` is present, it will use the versions and sources defined in
#' that file. If you're using the lockfile for some other purpose and
#' don't want it to affect deployment, add `renv.lock` to `.rscignore`.
#'
#' 2. Otherwise, rsconnect will call `renv::snapshot()` to find all packages
#' used by your code. If you'd instead prefer to only use the packages
#' declared in a `DESCRIPTION` file, run
#' `renv::settings$snapshot.type("explicit")` to activate renv's "explicit"
#' mode.
#'
#' 3. Dependency resolution using renv is a new feature in rsconnect 1.0.0, and
#' while we have done our best to test it, it still might fail for your app.
#' If this happens, please [file an issue](https://github.com/rstudio/rsconnect/issues)
#' then set `options(rsconnect.packrat = TRUE)` to revert to the old
#' dependency discovery mechanism.
#'
#' # Remote installation
#'
#' When deployed, the app must first install all of these packages, and
#' rsconnect ensures the versions used on the server will match the versions
#' you used locally. It knows how to install packages from the following
#' sources:
#'
#' * CRAN and BioConductor (`Source: CRAN` or `Source: Bioconductor`). The
#' remote server will ignore the specific CRAN or Bioconductor mirror that
#' you use locally, always using the CRAN/BioC mirror that has been configured
#' on the server.
#'
#' * Other CRAN like and CRAN-like repositories. These packages will have
#' a `Source` determined by the value of `getOptions("repos")`. For example,
#' if you've set the following options:
#'
#' ```R
#' options(
#' repos = c(
#' CRAN = "https://cran.rstudio.com/",
#' CORPORATE = "https://corporate-packages.development.company.com"
#' )
#' )
#' ```
#'
#' Then packages installed from your corporate package repository will
#' have source `CORPORATE`. Posit Connect
#' [can be configured](https://docs.posit.co/connect/admin/appendix/configuration/#RPackageRepository)
#' to override their repository url so that (e.g.) you can use different
#' packages versions on staging and production servers.
#'
#' * Packages installed from GitHub, GitLab, or BitBucket, have `Source`
#' `github`, `gitlab`, and `bitbucket` respectively. When deployed, the
#' bundle contains the additional metadata needed to precisely recreated
#' the installed version.
#'
#' It's not possible to recreate the packages that you have built and installed
#' from a directory on your local computer. This will have `Source: NA` and
#' will cause the deployment to error. To resolve this issue, you'll need to
#' install from one of the known sources described above.
#'
#' # Suggested packages
#'
#' The `Suggests` field is not included when determining recursive dependencies,
#' so it's possible that not every package required to run your application will
#' be detected.
#'
#' For example, ggplot2's `geom_hex()` requires the hexbin package to be
#' installed, but it is only suggested by ggplot2. So if your app uses
#' `geom_hex()` it will fail, reporting that the hexbin package is not
#' installed.
#'
#' You can overcome this problem with (e.g.) `requireNamespace(hexbin)`.
#' This will tell rsconnect that your app needs the hexbin package, without
#' otherwise affecting your code.
#'
#' @inheritParams deployApp
#' @returns A data frame with one row for each dependency (direct, indirect,
#' and inferred), and 4 columns:
#'
#' * `Package`: package name.
#' * `Version`: local version.
#' * `Source`: a short string describing the source of the package install,
#' as described above.
#' * `Repository`: for CRAN and CRAN-like repositories, the URL to the
#' repository. This will be ignored by the server if it has been configured
#' with its own repository name -> repository URL mapping.
#' @examples
#' \dontrun{
#'
#' # dependencies for the app in the current working dir
#' appDependencies()
#'
#' # dependencies for an app in another directory
#' appDependencies("~/projects/shiny/app1")
#' }
#' @seealso [rsconnectPackages](Using Packages with rsconnect)
#' @export
appDependencies <- function(appDir = getwd(),
appFiles = NULL,
appFileManifest = NULL,
appMode = NULL) {
appFiles <- listDeploymentFiles(appDir, appFiles, appFileManifest)
appMetadata <- appMetadata(appDir, appFiles = appFiles, appMode = appMode)
if (!needsR(appMetadata)) {
return(data.frame(
Package = character(),
Version = character(),
Source = character(),
Repository = character(),
stringsAsFactors = FALSE
))
}
bundleDir <- bundleAppDir(appDir, appFiles)
defer(unlink(bundleDir, recursive = TRUE))
extraPackages <- inferRPackageDependencies(appMetadata)
deps <- computePackageDependencies(bundleDir, extraPackages, quiet = TRUE)
deps[c("Package", "Version", "Source", "Repository")]
}
needsR <- function(appMetadata) {
if (appMetadata$appMode == "static") {
return(FALSE)
}
# All non-Quarto content currently uses R by default.
# Currently R is only supported by the "knitr" engine, not "jupyter" or
# "markdown"
is.null(appMetadata$quartoInfo) ||
"knitr" %in% appMetadata$quartoInfo[["engines"]]
}
inferRPackageDependencies <- function(appMetadata) {
deps <- switch(appMetadata$appMode,
"rmd-static" = c("rmarkdown", if (appMetadata$hasParameters) "shiny"),
"quarto-static" = "rmarkdown",
"quarto-shiny" = c("rmarkdown", "shiny"),
"rmd-shiny" = c("rmarkdown", "shiny"),
"shiny" = "shiny",
"api" = "plumber"
)
if (appMetadata$documentsHavePython) {
deps <- c(deps, "reticulate")
}
deps
}
rsconnect/R/imports.R 0000644 0001762 0000144 00000000270 14513230050 014261 0 ustar ligges users
#' @importFrom stats na.omit setNames
#' @importFrom utils available.packages installed.packages contrib.url getFromNamespace glob2rx packageVersion packageDescription read.csv
NULL
rsconnect/R/servers-deprec.R 0000644 0001762 0000144 00000002567 14513230050 015530 0 ustar ligges users #' Discover servers automatically
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' This function has never worked usefully, so has been removed.
#'
#' @export
#' @keywords internal
discoverServers <- function(quiet = FALSE) {
lifecycle::deprecate_warn("1.0.0", "discoverServers()")
discovered <- getOption("rsconnect.local_servers", "http://localhost:3939/__api__")
# get the URLs of the known servers, and silently add any that aren't yet
# present
existing <- servers()[, "url"]
introduced <- setdiff(discovered, existing)
lapply(introduced, function(url) { addServer(url, quiet = TRUE) })
if (!quiet && length(introduced) > 0) {
message("Discovered ", length(introduced),
(if (length(introduced) == 1) "server" else "servers"), ":")
lapply(introduced, message)
} else if (!quiet) {
message("No new servers found.")
}
invisible(introduced)
}
#' Add a server
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' This function does the same thing as [addServer()] so has been removed.
#'
#' @export
#' @inheritParams addServer
#' @keywords internal
addConnectServer <- function(url, name = NULL, certificate = NULL, quiet = FALSE) {
lifecycle::deprecate_warn("1.0.0", "addConnectServer()", "addServer()")
addServer(
ensureConnectServerUrl(url),
name = name,
certificate = certificate,
quiet = quiet
)
}
rsconnect/R/deployTFModel.R 0000644 0001762 0000144 00000001306 14513230050 015274 0 ustar ligges users #' Deploy a TensorFlow saved model
#'
#' This function is defunct. Posit Connect no longer supports hosting of
#' TensorFlow Model APIs. A TensorFlow model can be deployed as a
#' [Plumber API](https://tensorflow.rstudio.com/guides/deploy/plumber.html),
#' [Shiny application](https://tensorflow.rstudio.com/guides/deploy/shiny), or
#' other supported content type.
#'
#' @param modelDir Path to the saved model directory. Unused.
#' @param ... Unused.
#'
#' @family Deployment functions
#' @export
deployTFModel <- function(modelDir, ...) {
lifecycle::deprecate_stop(
when = "1.0.0",
what = "deployTFModel()",
details = "Posit Connect no longer supports hosting of TensorFlow Model APIs."
)
}
rsconnect/R/title.R 0000644 0001762 0000144 00000006265 14522164250 013727 0 ustar ligges users #' Generate Application Name
#'
#' @description
#' Generate a short name (identifier) for an application given an application
#' title.
#'
#' @param appTitle A descriptive title for the application.
#' @param appPath The path to the application's content, either a directory
#' or an individual document. Optional.
#' @param account The account where the application will be deployed. Optional.
#' @param unique Whether to try to generate a unique name.
#' @return
#' Returns a valid short name for the application.
#'
#' @details
#' This function modifies the title until it forms a suitable application name.
#' Suitable application names are 3 - 64 characters long and contain only
#' alphanumeric characters.
#'
#' The function is intended to be used to find a name for a new application.
#' If `appPath` and `account` are both specified, then the returned
#' name will also be unique among locally known deployments of the directory
#' (note that it is not guaranteed to be unique on the server). This behavior
#' can be disabled by setting `unique = FALSE`.
#'
#' @keywords internal
#' @examples
#' \dontrun{
#' # Generate a short name for a sample application
#' generateAppName("My Father's Country", "~/fathers-country", "myacct")
#' }
#' @export
generateAppName <- function(appTitle, appPath = NULL, account = NULL, unique = TRUE) {
munge <- function(title) {
# safe default if no title specified
if (is.null(title)) {
return("")
}
# start by removing most non-Latin characters and converting to lowercase
name <- tolower(gsub("[^A-Za-z0-9_ -]+", "", title))
# replace spaces with underscores
name <- gsub(" ", "_", name, fixed = TRUE)
# trim to 64 characters
if (nchar(name) > 64) {
name <- substr(name, 1, 64)
}
name
}
name <- munge(appTitle)
# 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)
}
# validate that we wound up with a valid name
if (nchar(name) < 3) {
stop("The generated app name '", name, "' is invalid. Include at least 3 ",
"alphanumeric characters in the title.")
}
# if we have an account and a directory, make the new app name unique to the
# best of our local knowledge
if (unique && !is.null(appPath) && nzchar(appPath) && !is.null(account)) {
apps <- deployments(appPath, accountFilter = account)
if (name %in% apps$name) {
# trim a few characters if necessary so we can add unique numbers to the end
base <- substr(name, 1, 62)
suffix <- 2
candidate <- paste0(base, suffix)
# keep incrementing the suffix until we find a unique name
while (candidate %in% apps$name) {
suffix <- suffix + 1
candidate <- paste0(base, suffix)
}
name <- candidate
}
}
name
}
rsconnect/R/appMetadata-quarto.R 0000644 0001762 0000144 00000003276 14513230050 016327 0 ustar ligges users inferQuartoInfo <- function(metadata, appDir, appPrimaryDoc) {
if (hasQuartoMetadata(metadata)) {
return(list(
version = metadata[["quarto_version"]],
engines = metadata[["quarto_engines"]]
))
}
# If we don't yet have Quarto details, run quarto inspect ourselves
inspect <- quartoInspect(
appDir = appDir,
appPrimaryDoc = appPrimaryDoc
)
if (is.null(inspect)) {
return(NULL)
}
list(
version = inspect[["quarto"]][["version"]],
engines = I(inspect[["engines"]])
)
}
hasQuartoMetadata <- function(x) {
!is.null(x$quarto_version)
}
# Run "quarto inspect" on the target and returns its output as a parsed object.
quartoInspect <- function(appDir = NULL, appPrimaryDoc = NULL) {
# If "quarto inspect appDir" fails, we will try "quarto inspect
# appPrimaryDoc", so that we can support single files as well as projects.
quarto <- quarto_path()
if (is.null(quarto)) {
cli::cli_abort(c(
"`quarto` not found.",
i = "Check that it is installed and available on your {.envvar PATH}."
))
}
paths <- c(appDir, file.path(appDir, appPrimaryDoc))
for (path in paths) {
args <- c("inspect", path.expand(path))
inspect <- tryCatch(
{
json <- suppressWarnings(system2(quarto, args, stdout = TRUE, stderr = TRUE))
parsed <- jsonlite::fromJSON(json)
return(parsed)
},
error = function(e) NULL
)
}
return(NULL)
}
# inlined from quarto::quarto_path()
quarto_path <- function() {
path_env <- Sys.getenv("QUARTO_PATH", unset = NA)
if (is.na(path_env)) {
path <- unname(Sys.which("quarto"))
if (nzchar(path)) {
path
} else {
NULL
}
} else {
path_env
}
}
rsconnect/NEWS.md 0000644 0001762 0000144 00000053557 14536677632 013410 0 ustar ligges users # rsconnect 1.2.0
* Addressed a number of republishing and collaboration issues where the
content was incorrectly published to a new location rather than reusing an
existing deployment. (#981, #1007, #1013, #1019)
* `showLogs()`, `configureApp()`, `setProperty()`, and `unsetProperty()`
search for the application by name when there are no matching deployment
records. (#985, #989)
* `rpubsUpload()` correctly records the initial RPubs destination, allowing
republishing. (#976)
* `deployApp()` and friends record multi-value `metadata` entries as
comma-separated values. (#1017)
* `accountInfo()` includes `name` and `username` fields. Older versions of
rsconnect store account records with a `username` field. Recent rsconnect
versions record `name`. Both `name` and `username` should contain the same
value. (#1024)
# rsconnect 1.1.1
* Added `space` parameter to deploy directly to a space in Posit Cloud.
* Improve reporting of errors returned by shinyapps.io. (#997)
* Remove most directory layout validation checks. (#998)
* Do not use `getOption("available_packages_filters")` option when calling
`available.packages()`. (#1002)
* Packages installed from source within an renv project are not associated
with repositories. (#1004)
# rsconnect 1.1.0
* Fixed analysis of directories that were smaller than the
`rsconnect.max.bundle.files=10000` limit but larger than the
`renv.config.dependencies.limit=1000` limit. (#968)
* Ignore `.env`, `.venv`, and `venv` files only when they reference Python
virtual environments. (#972)
* `deployApp()` and `writeManifest()` accept optional `envManagement`,
`envManagementR`, and `envManagementPy` arguments. These args specify whether
Posit Connect should install packages in the package cache.
If `envManagement` is `FALSE` then Connect will not perform any package
installation and it is the administrator's responsibility to ensure the
required R/Python packages are available in the runtime environment. This is
especially useful if off-host execution is enabled, when the execution
environment (specified by the `image` argument) already contains the required
packages. These values are ignored when
`Applications.ManifestEnvironmentManagementSelection = false`.
Requires Posit Connect `>=2023.07.0`. (#977)
* Fix account discovery by `showProperties()`. (#980)
# rsconnect 1.0.2
* Fixed redeployments to shinyapps.io where `appName` is provided, but no local
record of the deployment exists. (#932)
* `deployApp()` and `writeManifest()` now error if your library and `renv.lock`
are out-of-sync. Previously it always used what was defined in the `renv.lock`
but that was (a) slow and (b) could lead to different results than what you
see when running locally (#930).
* Deploying from an renv project includes the `renv.lock` in the bundle. A
manifest created for an renv project references the `renv.lock` in the
`manifest.json`. (#926)
* Use the environment variable `RSCONNECT_PACKRAT` to analyze dependencies
using packrat, as was done prior to rsconnect-1.0.0. Use of the
`rsconnect.packrat` option is discouraged, as it is not effective when using
push-button deployment in the RStudio IDE. (#935)
* The `renv.lock` is ignored when the `RSCONNECT_PACKRAT` environment variable
or the `rsconnect.packrat` option is set. (#936)
* The content type is inferred by analyzing the set of top-level files. (#942)
* `deployApp()` and `writeManifest()` accept an optional `appMode` argument.
Provide this argument if your project includes auxiliary files which mislead
the existing `appMode` inference. For example, if an HTML project includes
a downloadable Shiny `app.R`, that content will be assumed to be a Shiny
application even if that application is not meant to be run. (#948)
* `appDependencies()` accepts an `appFileManifest` argument as an alternate
way of providing the target set of files.
# rsconnect 1.0.1
* `deployDoc()` includes `.Rprofile`, `requirements.txt` and `renv.lock` when
deploying `.Rmd` or `.qmd`. These additional files are not included with
rendered HTML documents. (#919)
* Explicit renv dependencies are preserved. (#916)
# rsconnect 1.0.0
## New features
* `deployApp()` and `deployDoc()` now support deploying static content to Posit
Cloud. Static RMarkdown and Quarto content can be rendered server-side.
* rsconnect requires renv 1.0.0.
* `deployApp()` and `writeManifest()` now respect renv lock files, if present.
If you don't want to use these lockfiles, and instead return the previous
behaviour of snapshotting on every deploy, add your `renv.lock` to
`.rscignore` (#671). Learn more `?appDependencies()`.
Additionally, `deployApp()` and `writeManifest()` now use renv to capture app
dependencies, rather than packrat. If this causes a previously working deploy
to fail, please file an issue then set `options(rsconnect.packrat = TRUE)` to
revert to the previous behaviour.
* `deployApp()`'s `quarto` argument now takes values `TRUE`, `FALSE` or
`NA`. The previous value (a path to a quarto binary) is now ignored,
and instead we automatically figure out the package from `QUARTO_PATH` and
`PATH` env vars (#658). `deploySite()` now supports quarto websites (#813).
* `deployApp()` gains a new `envVars` argument which takes a vector of the
names of environment variables that should be securely copied to the server.
The names (not values) of these environment variables are also saved in the
deployment record and will be updated each time you re-deploy the app (#667).
This currently only works with Connect, but we hope to add support to
Posit cloud and shinyapps.io in the future.
* rsconnect gains two new functions for understanding and updating the
environment variables that your apps currently use. `listServerEnvVars()`
will return a data frame of applications, with a `envVars` list-column
giving the names of the environment variables used by each application.
`updateServerEnvVars()` will update all applications that use a specific
environment variable with the current value of that environment variable
(#667).
## Lifecycle changes
* Non-libcurl `rsconnect.http` options have been deprecated. This allows us to
focus our efforts on a single backend, rather than spreading development
efforts across five. The old backends will remain available for at least 2
years, but if you are using them because libcurl doesn't work for you, please
report the problem ASAP so we can fix it.
* `addConnectServer()` has been deprecated because it does the same
thing as `addServer()` now that `addServer()` also validates URLs.
* `deployTFModel()` is defunct. Posit Connect no longer supports hosting of
TensorFlow Model APIs. A TensorFlow model can be deployed as a [Plumber
API](https://tensorflow.rstudio.com/guides/deploy/plumber.html), [Shiny
application](https://tensorflow.rstudio.com/guides/deploy/shiny), or other
supported content type.
* `discoverServer()` has been deprecated; it never worked.
* `deployApp("foo.Rmd")` has been deprecated. It was never documented, and
it does the same job as `deployDoc()` (#698).
## Minor improvements and bug fixes
* New `rsconnect.http.headers` and `rsconnect.http.cookies` allow you to
set extra arbitrary additional headers/cookies on each request (#405).
Their use is documented in the new `vignette("custom-http")`.
* Uploading large files to RPubs works once more (#450).
* When recording details about deployments to Posit Cloud, appId now represents
the content id (as seen in URLs of the format
`https://posit.cloud/content/{id}`) instead of the application id.
* Deployment records no longer contain the time the app was deployed (`when`)
or when it's metadata was last synced (`lastSyncTime`) as these variables
are not very useful, and they lead to uninteresting diffs if you have
committed the deployment records to git (#770). A `version` field has been
added to deployment DCF files to facilitate future file format changes, if
needed. Its value for this release is `1`.,
* `accounts()` returns a zero-row data frame if no accounts are registered.
* `accountInfo()` and `removeAccount()` no longer require `account` be
supplied (#666).
* `accountInfo()` and `servers()` redact sensitive information (secrets,
private keys, and certificates) to make it hard to accidentally reveal
such information in logs (#675).
* `addServer()` includes the port in the default server name, if present.
* `appDependencies()` includes implicit dependencies, and returns an additional
column giving the Repository (#670). Its documentation contains more
information about how dependency discovery works, and how you can control
it, if needed.
* `applications()` now returns the application title, if available (#484),
and processes multiple pages of results from a Connect server (#860).
* `connectApiUser()` now clearly requires an `apiKey` (#741).
* `deployApp()` output has been thoroughly reviewed and tweaked. As well as
general polish it now gives you more information about what it has discovered
about the deployment, like the app name, account & server, and which files
are included in the bundle (#669).
* `deployApp()` is more aggressive about saving deployment data, which should
make it less likely that you need to repeat yourself after a failed
deployment. In particular, it now saves both before and after uploading the
contents (#677) and it saves when you're updating content originally created
by someone else (#270).
* `deployApp()` now gives an actionable error if you attempt to set
visibility of an app deployed to posit.cloud (#838).
* `deployApp()` now uses a stricter policy for determining whether or not
a locally installed package can be successfully installed on the deployment
server. This means that you're more likely to get a clean failure prior to
deployment (#659).
* `deployApp()` will now detect if you're attempting to publish to an app
that has been deleted and will prompt you to create a new app (#226).
* `deployApp()` includes some new conveniences for large uploads including
reporting the size of the bundle you're uploading and showing a progress bar
in interactive sessions (#754).
* `deployApp()` now follows redirects, which should make it more robust to your
server moving to a new url (#674).
* `deployApp()` uses simpler logic for determining whether it should create a
new app or update an existing app. Now `appName`, `account`, and `server` are
used to find existing deployments. If none are found, it will create a new
deployment; if one is found, it'll be updated; if more than one are found, it
will prompt you to disambiguate (#666).
* `deployApp()` improves account resolution from `account` and `server`
arguments by giving specific recommendations on the values that you might use
in the case of ambiguity or lack of matches (#666). Additionally, you'll now
receive a clear error if you accidentally provide something other than a
string or `NULL` to these arguments.
* `deployApp()` now generates an interactive prompt to select `account`/`server`
(if no previous deployments) or `appName`/`account`/`server` (if multiple
previous deployments) (#691).
* `deployApp()` now advertises which startup scripts are run at the normal
`logLevel`, and it evaluates each script in its own environment (#542).
* `deployApp()` now derives `appName` from `appDir` and `appPrimaryDoc`,
never using the title (#538). It now only simplifies the path if you are
publishing to shinyapps.io, since its restrictions on application names are
much tighter than those of Posit Connect.
* `deployApp()` will now warn if `appFiles` or `appManifestFiles` contain
files that don't exist, rather than silently ignoring them (#706).
* `deployApp()` excludes temporary backup files (names starting or ending
with `~`) when automatically determining files to bundle (#111) as well as
directories that are likely to be Python virtual environments (#632).
Additionally, ignore rules are always now applied to all directories;
previously some (like `.Rproj.user` and `"manifest.json"`) were only
applied to the root directory. It correctly handles `.rscignore` files
(i.e. as documented) (#568).
* `deployApp(appSourceDoc)` has been deprecated; it did the same job as
`recordDir`.
* `deployDoc()` includes a `.Rprofile` in the bundle, if one is found in the
same directory as the document.
* `lint()` should have fewer false positives for path problems:
the relative path linter has been removed (#244) and the case-sensitive
linter now only checks strings containing a `/` (#611).
* New `listDeploymentFiles()`, which supsersedes `listBundleFiles()`.
It now errors when if the bundle is either too large or contains too many
files, rather than silently truncating as before (#684).
* `serverInfo()` and `removeServer()` no longer require a `server` when
called interactively.
* `showMetrics()` once again returns a correctly named data frame (#528).
* Removed Rmd generation code (`writeRmdIndex()`) which had not worked, or
been necessary, for quite some time (#106, #109).
* Locale detection has been improved on windows (#233).
* The `rsconnect.pre.deploy` and `rsconnect.post.deploy` hooks are now always
called with the content directory, not sometimes the path to a specific file
(#696).
* Functions that should only interact with shinyapps.io enforce the server
type. Updated `addAuthorizedUser()`, `removeAuthorizedUser()`,
`showUsers()`, `showInvited()`, `resendInvitation()`, `configureApp()`,
`setProperty()`, `unsetProperty()`, `purgeApp()`, `restartApp()`,
`terminateApp()`, `showUsage()`, and `showMetrics()` (#863, #864).
* When needed packages are not installed, and you're in an interactive
environment, rsconnect will now prompt you to install them (#665).
* The confirmation prompt presented upon lint failures indicates "no" as its
default. (#652)
# rsconnect 0.8.29
* Introduced support for publishing to Posit Cloud. This feature is currently
in closed beta and requires access to an enabled account on Posit Cloud.
See [Posit Cloud's Announcement](https://posit.cloud/learn/whats-new#publishing)
for more information and to request access.
* Update company and product names for rebranding to Posit.
# rsconnect 0.8.28
* Shiny applications and Shiny documents no longer include an implicit
dependency on [`ragg`](https://ragg.r-lib.org) when that package is present
in the local environment. This reverts a change introduced in 0.8.27.
Shiny applications should add an explicit dependency on `ragg` (usually with
a `library("ragg")` statement) to see it used by `shiny::renderPlot` (via
`shiny::plotPNG`).
The documentation for `shiny::plotPNG` explains the use of `ragg`. (#598)
* Fix bug that prevented publishing or writing manifests for non-Quarto content
when a Quarto path was provided to the `quarto` argument of `writeManifest()`,
`deployApp()`, and related functions.
* Escape account names when performing a directory search to determine an
appropriate server. (#620)
# rsconnect 0.8.27
* Quarto content will no longer silently deploy as R Markdown content when
Quarto metadata is missing or cannot be gathered. Functions will error,
requesting the path to a Quarto binary in the `quarto` argument. (#594)
* Fix typo for `.rscignore`. (#599)
* Quarto deployments specifying only an `appDir` and `quarto` binary but not an
`appPrimaryDoc` work more consistently. A directory containing a `.qmd` file
will deploy as Quarto content instead of failing, and a directory containing
an `.Rmd` file will successfully deploy as Quarto content instead of falling
back to R Markdown. (#601)
* If the `ragg` package is installed locally, it is now added as an implicit
dependency to `shiny` apps since `shiny::renderPlot()` now uses it by default
(when available). This way, `shiny` apps won't have to add `library(ragg)` to
get consistent (higher-quality) PNG images when deployed. (#598)
# rsconnect 0.8.26
* Add ability to resend shinyapps.io application invitations (#543)
* Show expiration status in shinyapps.io for invitations (#543)
* Allow shinyapps.io deployments to be private at creation time (#403)
* Update the minimum `openssl` version to 2.0.0 to enable publishing for users
on FIPS-compliant systems without the need for API keys. (#452)
* Added Quarto support to `writeManifest`, which requires passing the absolute
path to a Quarto executable to its new `quarto` parameter
* Added `quarto` parameter to `deployApp` to enable deploying Quarto documents
and websites by supplying the path to a Quarto executable
* Added support for deploying Quarto content that uses only the `jupyter` runtime
* Added support for selecting a target `image` in the bundle manifest
* The `showLogs` function takes a `server` parameter. (#57)
* Added the `rsconnect.tar` option, which can be used to specify the path to a
`tar` implementation instead of R's internal implementation. The previous
method, using the `RSCONNECT_TAR` environment variable, still works, but the
new option will take precedence if both are set.
# rsconnect 0.8.25
* Use the `curl` option `-T` when uploading files to avoid out of memory
errors with large files. (#544)
* The `rsconnect.max.bundle.size` and `rsconnect.max.bundle.files` options are
enforced when processing an enumerated set of files. Previously, these
limits were enforced only when bundling an entire content directory. (#542)
* Preserve file time stamps when copying files into the bundle staging
directory, which then propagates into the created tar file. (#540)
* Configuration directories align with CRAN policy and use the location named
by `tools::R_user_dir`. Configuration created by earlier versions of this
package is automatically migrated to the new location. (#550)
# rsconnect 0.8.24
* Added support for publishing Quarto documents and websites
* Added support for `.rscignore` file to exclude files or directories from publishing (#368)
* Fixed issue causing missing value errors when publishing content containing filenames with extended characters (#514)
* Fixed issue preventing error tracebacks from displaying (#518)
# rsconnect 0.8.18
* Fixed issue causing configuration directory to be left behind after `R CMD CHECK`
* Fixed incorrect subdirectory nesting when storing configuration in `R_USER_CONFIG_DIR`
* Added linter for different-case Markdown links (#388)
* Use new Packrat release on CRAN, 0.6.0 (#501)
* Fix incorrect linter messages referring to `shiny.R` instead of `server.R` (#509)
* Warn, rather than err, when the repository URL for a package dependency
cannot be validated. This allows deployment when using archived CRAN
packages, or when using packages installed from source that are available on
the server. (#508)
* Err when the app-mode cannot be inferred; seen with empty directories/file-sets (#512)
* Add `verbose` option to `writeManifest` utility (#468)
# rsconnect 0.8.17
* Fixed issue where setting `options(rsconnect.http.trace.json = TRUE)` could cause deployment errors with some HTTP transports (#490)
* Improve how large bundles (file size and count) are detected (#464)
* The `RSCONNECT_TAR` environment variable can be used to select the tar implementation used to create bundles (#446)
* Warn when files are owned by users or groups with long names, as this can cause the internal R tar implementation to produce invalid archives (#446)
* Add support for syncing the deployment metadata with the server (#396)
* Insist on ShinyApps accounts in `showUsers()` (#398)
* Improve the regex used for the browser and browseURL lints to include a word boundary (#400)
* Fixed bug where `connectApiUser()` did not set a user id (#407)
* New arguments to `deployApp` to force the generation of a Python environment file or a `requirements.txt` file (#409)
* Fail when no repository URL is available for a dependent package (#410)
* Fix error when an old version of a package is installed and a current version isn't available (#431, #436)
* Fix error where packages couldn't be found with nonstandard contrib URLs. (#451, #457)
* Improve detection of Shiny R Markdown files when `server.R` is present (#461)
* Fix failure to write manifest when package requires a newer R version than the active version (#467)
* Increase default HTTP timeout on non-Windows platforms (#476)
* Require `packrat` 0.5 or later (#434)
* Fix error when handling empty application / content lists (#417, #395)
* Calls to `writeManifest()` no longer reference `packrat` files in the generated `manifest.json`. The `packrat` entries were transient and only existed while computing dependencies. (#472)
* Fix `applications` when ShinyApps does not return `size` details (#496)
* GitLab is seen as a valid SCM source (#491)
# rsconnect 0.8.16
* Prevent attempts to deploy Connect applications without uploading (#145)
* Flag usage of `browser()` debugging calls when deploying (#196)
* Prevent accidental deployment of Plumber APIs to shinyapps.io (#204)
* Allow `appId` and other global deployment parameters to `deploySite` (#231)
* Fix error when running `deployments()` without any registered accounts (#261)
* Omit `renv` files from deployment bundle (#367)
* Fix failure to deploy in Packrat projects (#370)
* Fix issue deploying when a package exists in multiple repos (#372)
* Honor `RETICULATE_PYTHON` when writing manifests (#374)
* Add `on.failure` user hook to run a function when `deployApp()` fails (#375)
* Fix error when showing non-streaming logs (#377)
* Use internally computed MD5 sums when MD5 is disabled in FIPS mode (#378, #382)
* Make it clearer which log entries are emitted by RStudio Connect (#385)
* Add support for `requirements.txt` for Python, if it exists (#386)
* Restore compatibility with R < 3.5 (#394)
* Add support for authenticating with Connect via an API key rather than a token (#393)
# rsconnect 0.8.15
* Switch from **RCurl** to **curl** as the default HTTP backend (#325)
* Add `purgeApp()` function to purge previously deployed shinyapps.io applications (#352)
rsconnect/MD5 0000644 0001762 0000144 00000042734 14536742742 012610 0 ustar ligges users 68606045302c2781878a22f3b26d24be *DESCRIPTION
b55cd0e3ffdca029c0817270fcfd8084 *NAMESPACE
17b0ead0622129c20f95ed948264918f *NEWS.md
b18067e85fd7c9727390f198eb90f92e *R/account-find.R
dd95690ae7af8db36e2e221319619a78 *R/accounts.R
a27d82bd834abc6982f2b572bff8cf8d *R/appDependencies.R
bec754a82dc2973420eb484ff14300c7 *R/appMetadata-quarto.R
8da4afb0188469d7e52e64791a090e38 *R/appMetadata.R
a9de5a16cd3d6534ee8c8e7c4414a149 *R/applications.R
83f12a46dc1408d27ae64935eb2bbde8 *R/auth.R
2ef3f1b3ab6948ebae258e319762c8bd *R/bundle.R
f13531b8c0a9cb918b0924d71a3aa718 *R/bundleFiles.R
c230b4f1cf0cbd05da0a2d38150d8b23 *R/bundlePackage.R
660cc9e12c46dcde121d326466d77ba6 *R/bundlePackagePackrat.R
b2abf5ad6394286f986adada8047d4c1 *R/bundlePackageRenv.R
90409ce683565af2d44543a7e097c972 *R/bundlePython.R
d45f273c2bb61f2d3fcfb9ebb472ba02 *R/certificates.R
50b3f8363fcd40180692f5aba286798c *R/client-cloud.R
b8b43cfc8ae25e67cea772750ad2bf57 *R/client-connect.R
356ea7a643cb40615a5111cd7f1e5f87 *R/client-shinyapps.R
1ed078b982736fabc664cb00df8d3604 *R/client.R
af9f63219195a7e437e4a180757b62a2 *R/config.R
9e5464126e6c5589d811f01a58b0c18f *R/configMigrate.R
a94d26fd0d2ab157625d88b127b38eee *R/configureApp.R
e9c10c87cd1ed981e1b7d9a01b568ad7 *R/cookies.R
03335c1fc361685890bf97c9959cc15b *R/deployAPI.R
381e7a0deac60c1936ce0ddfebd54dd4 *R/deployApp.R
e5100efd160275bb32a0ff6af40e0c09 *R/deployDoc.R
91c6496e2f4a074fd66e90873dd88cfe *R/deploySite.R
ee7edd8d8bdc341de817e4133d98fa82 *R/deployTFModel.R
ee6feb7156edddedfd1e2ac3654531ed *R/deploymentTarget.R
2f2d4627078c300a9629278a7a81d0f7 *R/deployments-find.R
dd0201c1b3a2fcb14bc46d8d49685b5c *R/deployments.R
07b598c061dcf021fed3297eea0e2ee7 *R/envvars.R
a33820530fa06e25273650698ef4d5bd *R/http-curl.R
acd29383e178ec8475d319c09f6908dc *R/http-internal.R
3f24d34ab0aa79e4cb5e71a8bac58c65 *R/http-libcurl.R
5da03ce806e00789b60c2a07fcc84f01 *R/http-rcurl.R
f9e26192f54319cdeaa84c46ceabb378 *R/http.R
6c4772eff25f96cd06fb48143ef95b21 *R/ide.R
8c5f08458cfd4e7f75a27924b2789c83 *R/import-standalone-obj-type.R
5b49b9c463766fac246aaf38deb93504 *R/import-standalone-types-check.R
61fb8363051cef7aa3b30a8561fc59df *R/imports.R
30b3ba170bdbd25a1a79c926288e3aca *R/lint-framework.R
3c208ecafb23384a35a15a93846d0076 *R/lint.R
d3899e3930dcb9607e97ef08dff38028 *R/linters.R
aaa2ffa5c1e1eb41acc88d5170387fe9 *R/locale.R
df6db08e5736db0e6c3e02c9ff92a95a *R/purgeApp.R
98a4fd412ad5325b9dbacbf00c56df9e *R/restartApp.R
b986ae754050bac4139f361ba5f2b9fd *R/rpubs.R
409a0f6ddf618355414c630aba1da996 *R/rsconnect-package.R
82af738f65bcec05814899ff041ea6fc *R/secret.R
127fa19d0fed9ac9ad5b28657a92bcb3 *R/servers-deprec.R
0937cf2e01f503316a0db99b862409b6 *R/servers.R
d41d8cd98f00b204e9800998ecf8427e *R/static-analysis.R
857dbd4f3221e0fbbd0a984542553715 *R/tasks.R
5462de334d684f10ea37f5b3be90b077 *R/terminateApp.R
915a8b2c1eec1e0d8175e4abde1955ad *R/title.R
dee26321f4ce67bbb46d457443adc320 *R/usage.R
dab1d18bb1b1d43fd33dbc8e62af62ab *R/utils-cli.R
1d07cc2449a07f8f6f4ee9c0d6039daf *R/utils.R
aa5294ab5224eb98fb8652dc10ae7c61 *R/writeManifest.R
d74b64b4b3975dc8ecd264790e3c9436 *README.md
43794bdeac721d782318bd8f2caec218 *build/vignette.rds
2aeba46562a9b9117a9217520f67adc0 *inst/cert/cacert.pem
2378364f2f7b529c5c5997413cd69d39 *inst/cert/shinyapps.io.pem
34cdb8c94e7941cbdc7fae1bdd1c84e9 *inst/doc/custom-http.R
ff7cda5df06795b98404748730db1f57 *inst/doc/custom-http.Rmd
0e7b304448cf60ca002b5a0cbe2a0004 *inst/doc/custom-http.html
dd9df5df88fdf07be178f552eda03d89 *inst/examples/diamonds/server.R
1b276d13ac94663d12f7a2521755c6ab *inst/examples/diamonds/ui.R
c4583de8a35d29910d6b24bcf5e1fb1d *inst/examples/sessioninfo/server.R
7dee3567e52504bac683fb9362147a36 *inst/examples/sessioninfo/ui.R
c90b28ab8304e1fc3e9ed0ea587af1fd *inst/resources/environment.py
f78bc3f369e2a5b1b671a99a2fd72f0f *man/accountUsage.Rd
50d71c291f7cd5611d9cf9a60c2a7a07 *man/accounts.Rd
684a857d51f1f8779b928b632980d955 *man/addAuthorizedUser.Rd
bcca327b0b6268c0ed449381105af199 *man/addConnectServer.Rd
b972c4e6a7112ea1204c5064fdc0f1a4 *man/addLinter.Rd
5f96c73a25675e426493ea535e21258b *man/addServer.Rd
3c0643157c4355112f88f3f8841fdddf *man/appDependencies.Rd
ed009d0fb02fb72ee22f51e196dad77b *man/applicationConfigDir.Rd
9b52edfb2d1d699bf9fe31c51ac86c10 *man/applications.Rd
dd4a3cdf6f8a526697bbd9334d890fcf *man/authorizedUsers.Rd
d0eee3c1b1e8d7a07bc02d0c8e2388e9 *man/configureApp.Rd
29cea1533a5f88566b29a0dcbade2827 *man/connectApiUser.Rd
b8ec40215d5748eaf03c342ef09f375e *man/deployAPI.Rd
e1fefd1bd55991194ac65dd70f65c130 *man/deployApp.Rd
a297130e785465a2083e2550fd31dba2 *man/deployDoc.Rd
5ac9507d8e9d3554946aa08a94ee96d7 *man/deploySite.Rd
0b9cacb8569580514c674fb2b1de06d0 *man/deployTFModel.Rd
8141d4f63969b3bfa9c7df403fb30006 *man/deployments.Rd
0029160e3c9eebd7bd70bbec4bdf991d *man/discoverServers.Rd
a1cbaf3f328e8d74e747faacf640c7fc *man/figures/lifecycle-archived.svg
6f521fb1819410630e279d1abf88685a *man/figures/lifecycle-defunct.svg
391f696f961e28914508628a7af31b74 *man/figures/lifecycle-deprecated.svg
691b1eb2aec9e1bec96b79d11ba5e631 *man/figures/lifecycle-experimental.svg
405e252e54a79b33522e9699e4e9051c *man/figures/lifecycle-maturing.svg
f41ed996be135fb35afe00641621da61 *man/figures/lifecycle-questioning.svg
306bef67d1c636f209024cf2403846fd *man/figures/lifecycle-soft-deprecated.svg
ed42e3fbd7cc30bc6ca8fa9b658e24a8 *man/figures/lifecycle-stable.svg
99f6e77d8cd1072e42e744a4950e143a *man/figures/lifecycle-superseded.svg
04524b9a1ab478bdac257e6ae4e97d85 *man/figures/logo.png
9978780470ec7957a7ca567f85319614 *man/figures/logo.svg
e3bd29df33942aa2223517ef0ac935f6 *man/forgetDeployment.Rd
ffce56fb53d8f1394e18171c2408941e *man/generateAppName.Rd
b13eede7a2c7df91552b5117bb14efe4 *man/lint.Rd
028f46e75c8496250fe4f9d06e28977c *man/linter.Rd
b9e3d5c2e05cbee03ada871727c920b1 *man/listAccountEnvVars.Rd
bf98c97392cb639ffe25352c99796c87 *man/listBundleFiles.Rd
c2cbd3cfaae4572ca998dec087b359fd *man/listDeploymentFiles.Rd
afb832c8f9b10a2951b7c7899a43f18d *man/makeLinterMessage.Rd
91bd64aff632fcf8acd33dc5c1a593d7 *man/oldApplicationConfigDir.Rd
34daa4b00d5464fef69e2ade09621766 *man/options.Rd
67f34d78895e2796db406151c67d5837 *man/purgeApp.Rd
d959f03abd1347873a0d08a80a0d7d66 *man/removeAuthorizedUser.Rd
fd7bda293474c8122268d540cb93ede8 *man/resendInvitation.Rd
53ecaecb030968be567a5338330e3fe2 *man/restartApp.Rd
c7e27d78d1cd7c0b92a200404ebb492f *man/rpubsUpload.Rd
92b479112c77995bd838055e62583041 *man/rsconnect-package.Rd
a3c3e1fce92b233f28b76ff7bef48ce4 *man/rsconnectConfigDir.Rd
d2daf29dbd1c31cbfe1864a81278519d *man/rsconnectPackages.Rd
a781b69f8d360ecf7558b36f7235bb7a *man/rsconnectProxies.Rd
85c709d23e204e4d6790991983c09464 *man/servers.Rd
8ac94e9c86338e1a32ecc850086b946e *man/setAccountInfo.Rd
bca598f599ff4f67fa608a78412cd740 *man/setProperty.Rd
f6be60a5fda83866c33b022dd6fc43a0 *man/showInvited.Rd
35d3b5761c3520d487949bf665568f60 *man/showLogs.Rd
7ff50af68f29ae845bcdb77a858d09b8 *man/showMetrics.Rd
f7381c79897359cd9442783ed59dd626 *man/showProperties.Rd
1dcdb65fb1758b688eb64e3f6b8edd3d *man/showUsage.Rd
a7ddebb09e4527c54d141884f742e52a *man/showUsers.Rd
f3d68c85eaac670b1f08cddc2336b062 *man/syncAppMetadata.Rd
10e38c5136d54e69794bd68064a8fa83 *man/taskLog.Rd
11d48b0e36c8da52c845335126460415 *man/tasks.Rd
0bc676496f2adf39370991ca5f270e6f *man/terminateApp.Rd
726c0636c49b19a9c0cc101414819b00 *man/unsetProperty.Rd
0bf280f189803785d67a4f1e1ce91356 *man/writeManifest.Rd
3a70f0034bf67db985f3c59103f26a27 *tests/manual/appMode.Rmd
6b34c1f91e7b9f758f8cd1a18942cdc8 *tests/manual/dependencies.Rmd
57cf966ca8ceb214cb5cb61344d454c7 *tests/manual/deploySite.Rmd
3f7d6aba077222a5c2f8519462d51ba9 *tests/manual/publishing-dialog.Rmd
51818524b66214f5b677fbb82f38af31 *tests/testthat.R
afbfedcf5b28461580f1dc0838aa14f3 *tests/testthat/_snaps/account-find.md
7208e02a31e9213972a3d6c149e136a3 *tests/testthat/_snaps/accounts.md
658a06866d867364349d3f5424e15ee0 *tests/testthat/_snaps/appDependencies.md
cf6fa968f3dd92d189b394f7e9f80902 *tests/testthat/_snaps/appMetadata-quarto.md
ebe285b6d25f51dd313fcd304051c75b *tests/testthat/_snaps/appMetadata.md
5653ed01e209a7b9e4eb19191576f878 *tests/testthat/_snaps/applications.md
c1fc1f71804fc2d5092d1129470f5b94 *tests/testthat/_snaps/bundle.md
6e18d29a541d3ae8ac4f9b10cbc93bb5 *tests/testthat/_snaps/bundleFiles.md
9bb36e2502dd8b4dc1861347cde02859 *tests/testthat/_snaps/bundlePackage.md
d55d8f6de699fb2bddcb73bcd40514dd *tests/testthat/_snaps/bundlePackagePackrat.md
0c1badbec4ba51c65d97cfdbd4e3bcef *tests/testthat/_snaps/bundlePackageRenv.md
fce16248e944fa4e43dbae00c5be4e3f *tests/testthat/_snaps/bundlePython.md
e6a7dc199abad18c49f1bcf85331e6f5 *tests/testthat/_snaps/cookies.md
f11783e9d82fd52d4d3449ad977045a7 *tests/testthat/_snaps/deployApp.md
b79b40c2bac04f8ef08c85aa5c593964 *tests/testthat/_snaps/deployDoc.md
e95f502db3f7fed996fb1a0279bd496c *tests/testthat/_snaps/deploymentTarget.md
e9c59d5fffc2a3a4dbf20d4d61d8b7c2 *tests/testthat/_snaps/deployments-find.md
15d48ce6f9c7533834ff0b6404d68bbb *tests/testthat/_snaps/deployments.md
8a0be89978ab887a10808d39496e6b83 *tests/testthat/_snaps/http-libcurl.md
33c467004e4d580902dc9bfb9c77191e *tests/testthat/_snaps/http.md
42446d4c8ac00460ac404ce2837b1e73 *tests/testthat/_snaps/ide.md
918758055afefa7fd276aadf9c857952 *tests/testthat/_snaps/lint.md
91f8d25cf144e338cde76677a1f4338c *tests/testthat/_snaps/linters.md
3fca8a9f7869bf2186a8f0d6bc2abec8 *tests/testthat/_snaps/secret.md
940bb21b0c25262220b99e0c4ebb89d1 *tests/testthat/_snaps/servers-deprec.md
df06aeb13137c211839f9e598efc0b53 *tests/testthat/_snaps/servers.md
20f7d93d3e38ffe001a55352e7f5ee6b *tests/testthat/_snaps/writeManifest.md
28358d7a7da5b98ef72f87ef9f7e3c71 *tests/testthat/certs/invalid.crt
2119c1e4e48a07544a2620810c8d9fe0 *tests/testthat/certs/localhost.crt
d35b5136333b0177b962a61506653041 *tests/testthat/certs/sample.crt
a38a451d1d8f8c2f4a438c9624a5a432 *tests/testthat/certs/store.crt
35989bf34a047efe49e71cabe2f3b055 *tests/testthat/certs/two-cas.crt
ef8154837fa51b4794f9919419b4b86e *tests/testthat/helper-http.R
d3ac096c8258b621b7cca61ec550b6a3 *tests/testthat/helper-paths.R
a215d744db977f01e383161df95e6754 *tests/testthat/helper.R
facf106f5d8245d54470f461b6730b7f *tests/testthat/multibyte-characters/app.R
873643945602ffbc56c89577fe33af42 *tests/testthat/packages/latin1package/DESCRIPTION
8b54e5a89fbda3af5e077053d40bec76 *tests/testthat/packages/latin1package/NAMESPACE
e5e0f10a3ef6eeab66ccbb80099ea1c5 *tests/testthat/packages/latin1package/R/hello.R
99567271980ebfdb87ea5653e5af0267 *tests/testthat/packages/latin1package/man/hello.Rd
6aaedf6a431c4acf676cb2d01b194447 *tests/testthat/packages/utf8package/DESCRIPTION
8b54e5a89fbda3af5e077053d40bec76 *tests/testthat/packages/utf8package/NAMESPACE
e5e0f10a3ef6eeab66ccbb80099ea1c5 *tests/testthat/packages/utf8package/R/hello.R
99567271980ebfdb87ea5653e5af0267 *tests/testthat/packages/utf8package/man/hello.Rd
c377ea1f04daab9e355461a245efa429 *tests/testthat/packages/windows1251package/DESCRIPTION
8b54e5a89fbda3af5e077053d40bec76 *tests/testthat/packages/windows1251package/NAMESPACE
e5e0f10a3ef6eeab66ccbb80099ea1c5 *tests/testthat/packages/windows1251package/R/hello.R
99567271980ebfdb87ea5653e5af0267 *tests/testthat/packages/windows1251package/man/hello.Rd
7cec49988744201b8587102340e23b16 *tests/testthat/project-MASS/MASS.R
3934e07d678ab1df32c048898d3e9441 *tests/testthat/quarto-doc-none/quarto-doc-none.qmd
b3ae14e020bebd8a266e50b690b7ec15 *tests/testthat/quarto-proj-r-shiny/_quarto.yml
58d6745717c2f4d942817eee0957ed31 *tests/testthat/quarto-proj-r-shiny/quarto-proj-r-shiny.qmd
b40cd4315c9165fc4714362fb37de47f *tests/testthat/quarto-website-py/_quarto.yml
774bb98825779ba5884422ea2ac0431b *tests/testthat/quarto-website-py/about.qmd
d72645570dc2d02270c398ae0a29b716 *tests/testthat/quarto-website-py/index.qmd
3d6786713ada9727e0371c63cd9b6455 *tests/testthat/quarto-website-py/requirements.txt
e31c3cdea03dfab8a29456978017bd10 *tests/testthat/quarto-website-py/styles.css
d075744c2de5c268bee12343b62f4191 *tests/testthat/quarto-website-r-py/_quarto.yml
a76d96fb10a2bc00261df0e593a83191 *tests/testthat/quarto-website-r-py/about.qmd
f6bfa05b658f18f162240e5c2119c76f *tests/testthat/quarto-website-r-py/index.qmd
f618019a224ed2f8e6bc39116267a173 *tests/testthat/quarto-website-r-py/requirements.txt
e31c3cdea03dfab8a29456978017bd10 *tests/testthat/quarto-website-r-py/styles.css
80577cb2b6d167108f0a17870911cec4 *tests/testthat/quarto-website-r/README.md
54d417481a8c9efc703c407cd68a4cc6 *tests/testthat/quarto-website-r/_quarto.yml
a754ce02c0472c0b163d8ffb898e69ac *tests/testthat/quarto-website-r/about.qmd
ea850466e0170ed3157c8e26bdc7ac91 *tests/testthat/quarto-website-r/index.qmd
e31c3cdea03dfab8a29456978017bd10 *tests/testthat/quarto-website-r/styles.css
7cec49988744201b8587102340e23b16 *tests/testthat/renv-recommended/dependences.R
d0360d35d74196e2d368b2255239ebde *tests/testthat/renv-recommended/renv.lock
d43a894bb2afaa0915043d9cf3c681cf *tests/testthat/shiny-app-in-subdir/my-app/server.R
99383448a53e115d08ae7a3e48af3d86 *tests/testthat/shiny-app-in-subdir/my-app/ui.r
0ac9325362678856ae8cee30cfbcff6d *tests/testthat/shiny-rmds/non-shiny-rmd.Rmd
9985f91dc258e78419eca67dbe710c6a *tests/testthat/shiny-rmds/shiny-rmd-dashes.Rmd
15e53373a9b8d9de81cc74eaef9816b3 *tests/testthat/shiny-rmds/shiny-rmd-dots.Rmd
70d0da110cd5fe44db2e0d88361596cb *tests/testthat/shinyapp-appR/app.R
782507835baf9dc5174849b2f23a8689 *tests/testthat/shinyapp-appR/rsconnect/colorado.posit.co/hadley/shinyapp-appR.dcf
0ef204e32d59f05adf1c2285c343193b *tests/testthat/shinyapp-simple/server.R
6c56aafc35413ea21878610ff30f170d *tests/testthat/shinyapp-simple/ui.R
70d0da110cd5fe44db2e0d88361596cb *tests/testthat/shinyapp-singleR/single.R
2a0790d076a8f6d31fdcb8d71c793693 *tests/testthat/shinyapp-with-absolute-paths/ShinyDocument.Rmd
1c158ec0250a43fd72c04bae04d26c8d *tests/testthat/shinyapp-with-absolute-paths/ShinyPresentation.Rmd
1d35c9da467943fbe5a516d6d7a6ad2a *tests/testthat/shinyapp-with-absolute-paths/data/College.txt
f23aef304963331a3140943e10e586fc *tests/testthat/shinyapp-with-absolute-paths/server.R
021b793fc81bd80128e9bec11cfd8b36 *tests/testthat/shinyapp-with-absolute-paths/ui.R
cafae18750ea211b29befe09d1036ab2 *tests/testthat/shinyapp-with-browser/server.R
6c56aafc35413ea21878610ff30f170d *tests/testthat/shinyapp-with-browser/ui.R
2c70795694d00afd0309082c5cbefa83 *tests/testthat/static-with-quarto-yaml/_quarto.yml
86bdd85fe7f0223b0a366debb21beb38 *tests/testthat/static-with-quarto-yaml/slideshow.html
7b0051124c431c4ca17c3cfe73bdf689 *tests/testthat/test-account-find.R
e2ccd88f1c27b7136d126d7227d72f51 *tests/testthat/test-accounts.R
51cc42da45698c62d1df1dc20a5b7621 *tests/testthat/test-appDependencies.R
560058d8e32ba9cb7b249d10b68940df *tests/testthat/test-appMetadata-quarto.R
2e4bf168e5850c249cc2ef206b954241 *tests/testthat/test-appMetadata.R
092ca0329b8241984a21417f7fedd8c8 *tests/testthat/test-applications.R
88428d57a6fbeacca159360c34ee0942 *tests/testthat/test-bundle.R
b8dfd6d787ef423b0c74f397d43325ef *tests/testthat/test-bundleFiles.R
d73b9cad74fbb0538a73b825d4846a28 *tests/testthat/test-bundlePackage.R
ce7447ba446a0c5a9422c3194460c279 *tests/testthat/test-bundlePackagePackrat.R
4c569ca19056e33bbd4776a84e456404 *tests/testthat/test-bundlePackageRenv.R
abedc9ff59f329d049eccafa0d7d7d24 *tests/testthat/test-bundlePython.R
f00bd6e1e2e7d0ff5c7172c810b78d8c *tests/testthat/test-cert.R
b0b6e38fbf1c85490ea6156a5cacab0c *tests/testthat/test-client-cloud.R
e6f16ffe5c534054d7ff7128b5e7e774 *tests/testthat/test-client-connect.R
22ad53af87737b4b110d5f39c242b1e2 *tests/testthat/test-client.R
a4c3c684243fef42b1d3a7b2a2da955e *tests/testthat/test-config.R
fb42cfee8b0669f0efddb60096d46e23 *tests/testthat/test-cookies.R
aec17219f486a9f6108d89ef4cc1ec14 *tests/testthat/test-deployApp.R
9b18acf0c35a760c2782172c950584e0 *tests/testthat/test-deployDoc.R
c8fd452277c9d3c534b7e80e5bac9d4a *tests/testthat/test-deploySite.R
56eb8ed47c08fadb2d33b6f88d9fce65 *tests/testthat/test-deploymentTarget.R
cd28d5b2cca75c18175633641ce58b18 *tests/testthat/test-deployments-find.R
f4f14d27ca8970ffa46ec47b161dae11 *tests/testthat/test-deployments.R
5c00104a9c8dbe087183277337bb6be0 *tests/testthat/test-http-curl.R
0605698a1d663edac0537ef04f6eddaf *tests/testthat/test-http-internal.R
c9b76d1982e7d993c51e6eb72c945d34 *tests/testthat/test-http-libcurl.R
d07996765ce6af1da9d23e20fcf349ac *tests/testthat/test-http-rcurl.R
be4df1c9a8119dcf624d5e03551bf6cc *tests/testthat/test-http.R
a51fd047805905accbfa608da4290fd5 *tests/testthat/test-ide.R
aa46a3376729c25ac37bef832cd36c43 *tests/testthat/test-lint.R
0480ccd71d2a7065d59ffa0c2cea2edb *tests/testthat/test-linters.R
18485c4a42334bb0411f1caa9c8fbdb4 *tests/testthat/test-locale.R
caf1244263fc0eef0787d0e604c8a3c0 *tests/testthat/test-plumber/plumber.R
ba99abf56aae6fec4d2a988d75070c4e *tests/testthat/test-reticulate-rmds/implicit.Rmd
c78f15224343592ea6ec67f83da59f85 *tests/testthat/test-reticulate-rmds/index.Rmd
07f51c85e4fe5d23e3b6b691c9b4239b *tests/testthat/test-rmd-bad-case/img/RStudio.svg
a1e6b39036aa4e8b63b333e6318ec3db *tests/testthat/test-rmd-bad-case/index.Rmd
579d8c200f96501ba5ceaa9296c1fd96 *tests/testthat/test-rmds/index.Rmd
f4fffcb3c1baaf6841f553e9aa7b1024 *tests/testthat/test-rmds/parameterized.Rmd
27ed9400e0161011c22d821bcef6e96f *tests/testthat/test-rmds/simple.Rmd
1019670988cc161cdd4fb04f9b5edb2f *tests/testthat/test-secret.R
c4db546d2f7ef422079ee498de8bd7dc *tests/testthat/test-servers-deprec.R
dcda64b47a2e8d00e8bd7f5ddaee5772 *tests/testthat/test-servers.R
3d03aed29a634daf1098730366428231 *tests/testthat/test-shinyApp/test-shinyApp.tar.gz
c907c603ffe887ac731f9710ea26a05e *tests/testthat/test-title.R
7bb23127b057846e2bf930e4e5da3f5d *tests/testthat/test-utils.R
db51ca0d771327d35be6f54372a3dc9a *tests/testthat/test-writeManifest.R
ff7cda5df06795b98404748730db1f57 *vignettes/custom-http.Rmd
rsconnect/inst/ 0000755 0001762 0000144 00000000000 14536677711 013246 5 ustar ligges users rsconnect/inst/examples/ 0000755 0001762 0000144 00000000000 14435652570 015056 5 ustar ligges users rsconnect/inst/examples/sessioninfo/ 0000755 0001762 0000144 00000000000 14456314431 017407 5 ustar ligges users rsconnect/inst/examples/sessioninfo/server.R 0000644 0001762 0000144 00000001236 14456314431 021042 0 ustar ligges users library(shiny)
shinyServer(function(input, output, session) {
# output sessionInfo
output$sessionInfo <- renderPrint({
sessionInfo()
})
# output urlInfo
output$urlInfo <- renderText({
paste(sep = "",
"protocol: ", session$clientData$url_protocol, "\n",
"hostname: ", session$clientData$url_hostname, "\n",
"pathname: ", session$clientData$url_pathname, "\n",
"port: ", session$clientData$url_port, "\n",
"search: ", session$clientData$url_search, "\n"
)
})
# output userInfo
output$userInfo <- renderText({
paste(sep = "",
"user: ", session$user, "\n")
})
})
rsconnect/inst/examples/sessioninfo/ui.R 0000644 0001762 0000144 00000000273 14435652570 020157 0 ustar ligges users library(shiny)
shinyUI(fluidPage(
h3("URL"),
verbatimTextOutput("urlInfo"),
h3("Session"),
verbatimTextOutput("sessionInfo"),
h3("User"),
verbatimTextOutput("userInfo")
))
rsconnect/inst/examples/diamonds/ 0000755 0001762 0000144 00000000000 14435652570 016654 5 ustar ligges users rsconnect/inst/examples/diamonds/server.R 0000644 0001762 0000144 00000001173 14435652570 020307 0 ustar ligges users library(shiny)
library(ggplot2)
shinyServer(function(input, output) {
dataset <- reactive(function() {
diamonds[sample(nrow(diamonds), input$sampleSize), ]
})
output$plot <- reactivePlot(function() {
p <- ggplot(dataset(), aes_string(x = input$x, y = input$y)) + geom_point()
if (input$color != "None")
p <- p + aes_string(color = input$color)
facets <- paste(input$facet_row, "~", input$facet_col)
if (facets != ". ~ .")
p <- p + facet_grid(facets)
if (input$jitter)
p <- p + geom_jitter()
if (input$smooth)
p <- p + geom_smooth()
print(p)
}, height = 700)
})
rsconnect/inst/examples/diamonds/ui.R 0000644 0001762 0000144 00000001334 14435652570 017415 0 ustar ligges users library(shiny)
library(ggplot2)
dataset <- diamonds
shinyUI(pageWithSidebar(
headerPanel("Diamonds Explorer"),
sidebarPanel(
sliderInput("sampleSize", "Sample Size", min = 1, max = nrow(dataset),
value = min(1000, nrow(dataset)), step = 500, round = 0),
selectInput("x", "X", names(dataset)),
selectInput("y", "Y", names(dataset), names(dataset)[[2]]),
selectInput("color", "Color", c("None", names(dataset))),
checkboxInput("jitter", "Jitter"),
checkboxInput("smooth", "Smooth"),
selectInput("facet_row", "Facet Row", c(None = ".", names(dataset))),
selectInput("facet_col", "Facet Column", c(None = ".", names(dataset)))
),
mainPanel(
plotOutput("plot")
)
))
rsconnect/inst/doc/ 0000755 0001762 0000144 00000000000 14536677711 014013 5 ustar ligges users rsconnect/inst/doc/custom-http.R 0000644 0001762 0000144 00000001417 14536677711 016430 0 ustar ligges users ## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
## ----setup--------------------------------------------------------------------
library(rsconnect)
## -----------------------------------------------------------------------------
options(
rsconnect.http.headers = c(
"CustomHeader1" = "CustomValue", "CustomHeader2" = "CustomValue2"
)
)
## -----------------------------------------------------------------------------
options(
rsconnect.http.headers = c("cookie1=value1", "cookie2=value2")
)
## -----------------------------------------------------------------------------
options(
rsconnect.http.headers = "cookie1=value1; Expires=Thu, 31 Oct 2021 07:28:00 GMT; Secure"
)
rsconnect/inst/doc/custom-http.Rmd 0000644 0001762 0000144 00000006117 14513230050 016723 0 ustar ligges users ---
title: "Customising HTTP requests"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Customising HTTP requests}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
```
```{r setup}
library(rsconnect)
```
Depending on the configuration of your environment, you may need to cutomize the way that rsconnect sends http requests. Typically, this is required for some special
## `.rsconnect_profile`
When deploying content from the RStudio IDE, the rsconnect package's deployment methods are executed in a vanilla R session that doesn't execute startup scripts. This can make it challenging to ensure options are set properly prior to push-button deployment, so the rsconnect package has a parallel set of "startup" scripts it runs prior to deploying.
The following are run in order, if they exist, prior to deployment:
* `$R_HOME/etc/rsconnect.site`: Like `Rprofile.site` for site-wide pre-flight and options.
This is typically used by system administrators.
* `~/.rsconnect_profile`, like `.Rprofile`; this will affect all apps that you deploy.
* `.rsconnect_profile`, like `.Rprofile`; this will affect the current app.
Unlike `.Rprofile`, if `~/.rsconnect_profile`, is present, it will also be run.
## HTTP Proxy Environment Variable
The most straightforward way to specify a proxy is to set the `HTTPS_PROXY` environment variable. For example, you could add the following code to your `.rsconnect_profile`:
```R
Sys.setenv(https_proxy = "https://proxy.example.com")
```
Proxy settings can include a host-name, port, and username/password if necessary. The following
are all valid values for the `http_proxy` environment variable:
* `http://proxy.example.com/`
* `http://proxy.example.com:1080/`
* `http://username:password@proxy.example.com:1080/`
## Custom headers and cookies
If you need to supply additional headers or cookies, you can use the options `rsconnect.http.headers` and `rsconnect.http.cookies` respectively. `rsconnect.http.headers` needs a named vector of header names and values:
```{r}
options(
rsconnect.http.headers = c(
"CustomHeader1" = "CustomValue", "CustomHeader2" = "CustomValue2"
)
)
```
While `rsconnect.http.cookies` expects cookies formatted the same way that a webserver expects them:
```{r}
options(
rsconnect.http.headers = c("cookie1=value1", "cookie2=value2")
)
```
And you can supply other cookie parameters if needed:
```{r}
options(
rsconnect.http.headers = "cookie1=value1; Expires=Thu, 31 Oct 2021 07:28:00 GMT; Secure"
)
```
The custom headers are set first, so will be overridden by the headers that rsconnect needs to correctly operate. Similarly, cookies will be set prior to the first request, and will be overriden by anything returned by the server.
## Other custom options
Finally, you can supply any additional options supported by `curl::curl_options()` with `rsconnect.libcurl.options`, e.g.
```R
options(rsconnect.libcurl.options = list(proxy = "http://proxy.example.com")
```
Run `curl::curl_options()` to see a list of options.
rsconnect/inst/doc/custom-http.html 0000644 0001762 0000144 00000033241 14536677711 017173 0 ustar ligges users
Customising HTTP requests
Customising HTTP requests
library(rsconnect)
Depending on the configuration of your environment, you may need to
cutomize the way that rsconnect sends http requests. Typically, this is
required for some special
.rsconnect_profile
When deploying content from the RStudio IDE, the rsconnect package’s
deployment methods are executed in a vanilla R session that doesn’t
execute startup scripts. This can make it challenging to ensure options
are set properly prior to push-button deployment, so the rsconnect
package has a parallel set of “startup” scripts it runs prior to
deploying.
The following are run in order, if they exist, prior to
deployment:
$R_HOME/etc/rsconnect.site: Like
Rprofile.site for site-wide pre-flight and options. This is
typically used by system administrators.
~/.rsconnect_profile, like .Rprofile;
this will affect all apps that you deploy.
.rsconnect_profile, like .Rprofile;
this will affect the current app. Unlike .Rprofile, if
~/.rsconnect_profile, is present, it will also be
run.
HTTP Proxy Environment Variable
The most straightforward way to specify a proxy is to set the
HTTPS_PROXY environment variable. For example, you could
add the following code to your .rsconnect_profile:
Proxy settings can include a host-name, port, and username/password
if necessary. The following are all valid values for the
http_proxy environment variable:
http://proxy.example.com/
http://proxy.example.com:1080/
http://username:password@proxy.example.com:1080/
Custom headers and cookies
If you need to supply additional headers or cookies, you can use the
options rsconnect.http.headers and
rsconnect.http.cookies respectively.
rsconnect.http.headers needs a named vector of header names
and values:
And you can supply other cookie parameters if needed:
options(rsconnect.http.headers ="cookie1=value1; Expires=Thu, 31 Oct 2021 07:28:00 GMT; Secure")
The custom headers are set first, so will be overridden by the
headers that rsconnect needs to correctly operate. Similarly, cookies
will be set prior to the first request, and will be overriden by
anything returned by the server.
Other custom options
Finally, you can supply any additional options supported by
curl::curl_options() with
rsconnect.libcurl.options, e.g.
