diff --git a/CHANGELOG.md b/CHANGELOG.md index de472f62..7cd7f946 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,10 @@ # Change Log for Dash for R All notable changes to this project will be documented in this file. -## Unreleased +## [0.2.0] - 2019-12-23 ### Added +- Support for asynchronous/dynamic loading of dependencies, resource caching, and asset fingerprinting [#157](https://github.com/plotly/dashR/pull/157) +- Compression of text resources using `brotli`, `gzip`, or `deflate` [#157](https://github.com/plotly/dashR/pull/157) - Support for adding `` tags to index [#142](https://github.com/plotly/dashR/pull/142) - Hot reloading now supported in debug mode [#127](https://github.com/plotly/dashR/pull/127) - Support for displaying Dash for R applications within RStudio's viewer pane when `use_viewer = TRUE` diff --git a/DESCRIPTION b/DESCRIPTION index 57db7519..7a2d5289 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,19 +1,19 @@ Package: dash Title: An Interface to the Dash Ecosystem for Authoring Reactive Web Applications -Version: 0.1.0 +Version: 0.2.0 Authors@R: c(person("Chris", "Parmer", role = c("aut"), email = "chris@plot.ly"), person("Ryan Patrick", "Kyle", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-5829-9867"), email = "ryan@plot.ly"), person("Carson", "Sievert", role = c("aut"), comment = c(ORCID = "0000-0002-4958-2844")), person(family = "Plotly Technologies", role = "cph")) Description: A framework for building analytical web applications, Dash offers a pleasant and productive development experience. No JavaScript required. Depends: R (>= 3.0.2) Imports: - dashHtmlComponents (== 1.0.0), - dashCoreComponents (== 1.0.0), - dashTable (== 4.0.2), + dashHtmlComponents (== 1.0.2), + dashCoreComponents (== 1.6.0), + dashTable (== 4.5.1), R6, fiery (> 1.0.0), routr (> 0.2.0), plotly, - reqres, + reqres (>= 0.2.3), jsonlite, htmltools, assertthat, @@ -31,9 +31,9 @@ Collate: 'imports.R' 'print.R' 'internal.R' -Remotes: plotly/dash-html-components@17da1f4, - plotly/dash-core-components@cc1e654, - plotly/dash-table@042ad65 +Remotes: plotly/dash-html-components@55c3884, + plotly/dash-core-components@c107e0f, + plotly/dash-table@3058bd5 License: MIT + file LICENSE Encoding: UTF-8 LazyData: true diff --git a/R/dash.R b/R/dash.R index 1ed54bb4..83b3392b 100644 --- a/R/dash.R +++ b/R/dash.R @@ -9,6 +9,7 @@ #' server = fiery::Fire$new(), #' assets_folder = 'assets', #' assets_url_path = '/assets', +#' eager_loading = FALSE, #' assets_ignore = '', #' serve_locally = TRUE, #' meta_tags = NULL, @@ -30,6 +31,7 @@ #' .css files will be loaded immediately unless excluded by `assets_ignore`, #' and other files such as images will be served if requested. Default is `assets`. \cr #' `assets_url_path` \tab \tab Character. Specify the URL path for asset serving. Default is `assets`. \cr +#' `eager_loading` \tab \tab Logical. Controls whether asynchronous resources are prefetched (if `TRUE`) or loaded on-demand (if `FALSE`). \cr #' `assets_ignore` \tab \tab Character. A regular expression, to match assets to omit from #' immediate loading. Ignored files will still be served if specifically requested. You #' cannot use this to prevent access to sensitive files. \cr @@ -126,7 +128,10 @@ #' #' @examples #' \dontrun{ +#' library(dashCoreComponents) +#' library(dashHtmlComponents) #' library(dash) + #' app <- Dash$new() #' app$layout( #' dccInput(id = "inputID", value = "initial value", type = "text"), @@ -160,6 +165,7 @@ Dash <- R6::R6Class( server = fiery::Fire$new(), assets_folder = 'assets', assets_url_path = '/assets', + eager_loading = FALSE, assets_ignore = '', serve_locally = TRUE, meta_tags = NULL, @@ -167,6 +173,7 @@ Dash <- R6::R6Class( requests_pathname_prefix = NULL, external_scripts = NULL, external_stylesheets = NULL, + compress = TRUE, suppress_callback_exceptions = FALSE) { # argument type checking @@ -178,12 +185,14 @@ Dash <- R6::R6Class( # save relevant args as private fields private$name <- name private$serve_locally <- serve_locally + private$eager_loading <- eager_loading # remove leading and trailing slash(es) if present private$assets_folder <- gsub("^/+|/+$", "", assets_folder) # remove trailing slash in assets_url_path, if present private$assets_url_path <- sub("/$", "", assets_url_path) private$assets_ignore <- assets_ignore private$suppress_callback_exceptions <- suppress_callback_exceptions + private$compress <- compress private$app_root_path <- getAppPath() private$app_launchtime <- as.integer(Sys.time()) private$meta_tags <- meta_tags @@ -240,6 +249,9 @@ Dash <- R6::R6Class( response$body <- to_JSON(lay, pretty = TRUE) response$status <- 200L response$type <- 'json' + + + TRUE }) @@ -250,6 +262,7 @@ Dash <- R6::R6Class( response$body <- to_JSON(list()) response$status <- 200L response$type <- 'json' + return(FALSE) } @@ -265,6 +278,8 @@ Dash <- R6::R6Class( response$body <- to_JSON(setNames(payload, NULL)) response$status <- 200L response$type <- 'json' + if (private$compress) + response <- tryCompress(request, response) TRUE }) @@ -393,17 +408,33 @@ Dash <- R6::R6Class( response$status <- 500L private$stack_message <- NULL } + + if (private$compress) + response <- tryCompress(request, response) TRUE }) # This endpoint supports dynamic dependency loading # during `_dash-update-component` -- for reference: - # https://github.com/plotly/dash/blob/1249ffbd051bfb5fdbe439612cbec7fa8fff5ab5/dash/dash.py#L488 # https://docs.python.org/3/library/pkgutil.html#pkgutil.get_data + # + # analogous to + # https://github.com/plotly/dash/blob/2d735aa250fc67b14dc8f6a337d15a16b7cbd6f8/dash/dash.py#L543-L551 dash_suite <- paste0(self$config$routes_pathname_prefix, "_dash-component-suites/:package_name/:filename") - + route$add_handler("get", dash_suite, function(request, response, keys, ...) { filename <- basename(file.path(keys$filename)) + + # checkFingerprint returns a list of length 2, the first element is + # the un-fingerprinted path, if a fingerprint is present (otherwise + # the original path is returned), while the second element indicates + # whether the original filename included a valid fingerprint (by + # Dash convention) + fingerprinting_metadata <- checkFingerprint(filename) + + filename <- fingerprinting_metadata[[1]] + has_fingerprint <- fingerprinting_metadata[[2]] == TRUE + dep_list <- c(private$dependencies_internal, private$dependencies, private$dependencies_user) @@ -413,7 +444,6 @@ Dash <- R6::R6Class( clean_dependencies(dep_list) ) - # return warning if a dependency goes unmatched, since the page # will probably fail to render properly anyway without it if (length(dep_pkg$rpkg_path) == 0) { @@ -424,16 +454,44 @@ Dash <- R6::R6Class( response$body <- NULL response$status <- 404L } else { + # need to check for debug mode, don't cache, don't etag + # if debug mode is not active dep_path <- system.file(dep_pkg$rpkg_path, package = dep_pkg$rpkg_name) - + response$body <- readLines(dep_path, warn = FALSE, encoding = "UTF-8") - response$status <- 200L + + if (!private$debug && has_fingerprint) { + response$status <- 200L + response$set_header('Cache-Control', + sprintf('public, max-age=%s', + 31536000) # 1 year + ) + } else if (!private$debug && !has_fingerprint) { + modified <- as.character(as.integer(file.mtime(dep_path))) + + response$set_header('ETag', modified) + + request_etag <- request$headers[["If-None-Match"]] + + if (!is.null(request_etag) && modified == request_etag) { + response$body <- NULL + response$status <- 304L + } else { + response$status <- 200L + } + } else { + response$status <- 200L + } + response$type <- get_mimetype(filename) } + if (private$compress && length(response$body) > 0) + response <- tryCompress(request, response) + TRUE }) @@ -476,14 +534,20 @@ Dash <- R6::R6Class( response$body <- readLines(asset_path, warn = FALSE, encoding = "UTF-8") + + if (private$compress && length(response$body) > 0) { + response <- tryCompress(request, response) + } } else { file_handle <- file(asset_path, "rb") + file_size <- file.size(asset_path) + response$body <- readBin(file_handle, raw(), - file.size(asset_path)) + file_size) close(file_handle) } - + response$status <- 200L } TRUE @@ -501,8 +565,13 @@ Dash <- R6::R6Class( file.size(asset_path)) close(file_handle) + response$set_header('Cache-Control', + sprintf('public, max-age=%s', + '31536000') + ) response$type <- 'image/x-icon' response$status <- 200L + TRUE }) @@ -512,6 +581,9 @@ Dash <- R6::R6Class( response$body <- private$.index response$status <- 200L response$type <- 'html' + + if (private$compress) + response <- tryCompress(request, response) TRUE }) @@ -540,6 +612,7 @@ Dash <- R6::R6Class( response$body <- to_JSON(resp) response$status <- 200L response$type <- 'json' + # reset the field for the next reloading operation private$modified_since_reload <- list() TRUE @@ -830,6 +903,7 @@ Dash <- R6::R6Class( # private fields defined on initiation name = NULL, serve_locally = NULL, + eager_loading = NULL, meta_tags = NULL, assets_folder = NULL, assets_url_path = NULL, @@ -837,6 +911,7 @@ Dash <- R6::R6Class( routes_pathname_prefix = NULL, requests_pathname_prefix = NULL, suppress_callback_exceptions = NULL, + compress = NULL, asset_map = NULL, css = NULL, scripts = NULL, @@ -1188,7 +1263,24 @@ Dash <- R6::R6Class( css_deps <- render_dependencies(css_deps, local = private$serve_locally, prefix=self$config$requests_pathname_prefix) - + + # ensure that no dependency has both async and dynamic set + if (any( + vapply(depsAll, function(dep) + length(intersect(c("dynamic", "async"), names(dep))) > 1, + logical(1) + ) + ) + ) + stop("Can't have both 'dynamic' and 'async' in a Dash dependency; please correct and reload.", call. = FALSE) + + # remove dependencies which are dynamic from the script list + # to avoid placing them into the index + depsAll <- depsAll[!vapply(depsAll, + isDynamic, + logical(1), + eager_loading = private$eager_loading)] + # scripts go after dash-renderer dependencies (i.e., React), # but before dash-renderer itself scripts_deps <- compact(lapply(depsAll, function(dep) { diff --git a/R/utils.R b/R/utils.R index 311a7529..90213e18 100644 --- a/R/utils.R +++ b/R/utils.R @@ -155,31 +155,7 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) { # package and add the version number of the package as a query # parameter for cache busting if (!is.null(dep$package)) { - if(!(is.null(dep$script))) { - filename <- dep$script - } else { - filename <- dep$stylesheet - } - - dep_path <- paste(dep$src$file, filename, sep="/") - - # the gsub line is to remove stray duplicate slashes, to - # permit exact string matching on pathnames - dep_path <- gsub("//+", - "/", - dep_path) - - full_path <- system.file(dep_path, - package = dep$package) - - if (!file.exists(full_path)) { - warning(sprintf("The dependency path '%s' within the '%s' package is invalid; cannot find '%s'.", - full_path, - dep$package, - filename), - call. = FALSE) - } - + full_path <- getDependencyPath(dep) modified <- as.integer(file.mtime(full_path)) } else { modified <- as.integer(Sys.time()) @@ -191,8 +167,10 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) { if ("script" %in% names(dep) && tools::file_ext(dep[["script"]]) != "map") { if (!(is_local) & !(is.null(dep$src$href))) { html <- generate_js_dist_html(href = dep$src$href) - } else { + script_mtime <- file.mtime(getDependencyPath(dep)) + modtime <- as.integer(script_mtime) + dep$script <- buildFingerprint(dep$script, dep$version, modtime) dep[["script"]] <- paste0(path_prefix, "_dash-component-suites/", dep$name, @@ -1097,10 +1075,15 @@ dashLogger <- function(event = NULL, # is called from a private method within the Dash() R6 class; this makes # accessing variables set within Dash's private fields somewhat complicated # - # the following line retrieves the value of the silence_route_logging parameter, - # which is nearly 20 frames up the stack; if it's not found, we'll assume FALSE - silence_routes_logging <- dynGet("self", ifnotfound = FALSE)$config$silence_routes_logging - + # the following lines retrieve the value of the silence_route_logging parameter, + # which is many frames up the stack; if it's not found, we'll assume FALSE + self_object <- dynGet("self", ifnotfound = NULL) + + if (!is.null(self_object)) + silence_routes_logging <- self_object$config$silence_routes_logging + else + silence_routes_logging <- FALSE + if (!is.null(event)) { msg <- sprintf("%s: %s", event, message) @@ -1161,3 +1144,122 @@ dashLogger <- function(event = NULL, clientsideFunction <- function(namespace, function_name) { return(list(namespace=namespace, function_name=function_name)) } + +buildFingerprint <- function(path, version, hash_value) { + path <- file.path(path) + filename <- getFileSansExt(path) + extension <- getFileExt(path) + + sprintf("%s.v%sm%s.%s", + file.path(dirname(path), filename), + gsub("[^\\w-]", "_", version, perl = TRUE), + hash_value, + extension) +} + +checkFingerprint <- function(path) { + name_parts <- unlist(strsplit(basename(path), ".", fixed = TRUE)) + + # Check if the resource has a fingerprint + if ((length(name_parts) > 2) && grepl("^v[\\w-]+m[0-9a-fA-F]+$", name_parts[2], perl = TRUE)) { + return(list(paste(name_parts[name_parts != name_parts[2]], collapse = "."), TRUE)) + } + return(list(basename(path), FALSE)) +} + +getDependencyPath <- function(dep) { + if (missing(dep)) { + stop("getDependencyPath requires that a valid dependency object is passed. Please verify that dep is non-missing.") + } + + if(!(is.null(dep$script))) { + filename <- checkFingerprint(dep$script)[[1]] + dirname <- returnDirname(dep$script) + } else { + filename <- dep$stylesheet + dirname <- returnDirname(filename) + } + + dep_path <- file.path(dep$src$file, filename) + + # the gsub line is to remove stray duplicate slashes, to + # permit exact string matching on pathnames + dep_path <- gsub("//+", + "/", + dep_path) + + # this may generate doubled slashes, which should not + # pose problems on Mac OS, Windows, or Linux systems + full_path_to_dependency <- system.file(file.path(dep$src$file, + dirname, + filename), + package=dep$package) + + if (!file.exists(full_path_to_dependency)) { + write(crayon::yellow(sprintf("The dependency path '%s' within the '%s' package is invalid; cannot find '%s'.", + dep_path, + dep$package, + filename) + ), + stderr()) + } + + return(full_path_to_dependency) +} + +# the base R functions which strip extensions and filenames without +# extensions from paths are not robust to multipart extensions, +# such as .js.map or .min.js; these are functions intended to +# perform reliably in such cases. the first occurrence of a dot +# is replaced with an asterisk, which is generally an invalid +# filename character in any modern filesystem, since it represents +# a wildcard. the resulting string is then split on the asterisk. +getFileSansExt <- function(filepath) { + unlist(strsplit(sub("[.]", "*", basename(filepath)), "[*]"))[1] +} + +getFileExt <- function(filepath) { + unlist(strsplit(sub("[.]", "*", basename(filepath)), "[*]"))[2] +} + +returnDirname <- function(filepath) { + dirname <- dirname(filepath) + if (is.null(dirname) || dirname == ".") + return("") + return(dirname) +} + +isDynamic <- function(eager_loading, resource) { + if ( + is.null(resource$dynamic) && is.null(resource$async) + ) + return(FALSE) + # need assert that async and dynamic are not both present + if ( + (!is.null(resource$dynamic) && (resource$dynamic == FALSE)) || + (eager_loading==TRUE && !is.null(resource$async) && (resource$async %in% c("eager", TRUE))) + ) + return(FALSE) + else + return(TRUE) +} + +tryCompress <- function(request, response) { + # charToRaw requires a length one character string + response$body <- paste(response$body, collapse="\n") + # the reqres gzip implementation requires file I/O + # brotli does not; when available, use brotli with + # a moderate level of compression for speed -- + # the viewer pane only supports gzip and deflate, + # so gzip will be used when launching apps within + # RStudio + tryBrotli <- request$accepts_encoding('br') + if (tryBrotli == "br") { + response$body <- brotli::brotli_compress(charToRaw(response$body), + quality = 3) + response$set_header('Content-Encoding', + "br") + return(response) + } + return(response$compress()) +} diff --git a/man/Dash.Rd b/man/Dash.Rd index 3fcd2858..a27f4a62 100644 --- a/man/Dash.Rd +++ b/man/Dash.Rd @@ -17,8 +17,10 @@ name = "dash", server = fiery::Fire$new(), assets_folder = 'assets', assets_url_path = '/assets', +eager_loading = FALSE, assets_ignore = '', serve_locally = TRUE, +meta_tags = NULL, routes_pathname_prefix = '/', requests_pathname_prefix = '/', external_scripts = NULL, @@ -39,11 +41,15 @@ for extra files to be used in the browser. Default is "assets". All .js and .css files will be loaded immediately unless excluded by \code{assets_ignore}, and other files such as images will be served if requested. Default is \code{assets}. \cr \code{assets_url_path} \tab \tab Character. Specify the URL path for asset serving. Default is \code{assets}. \cr +\code{eager_loading} \tab \tab Logical. Controls whether asynchronous resources are prefetched (if \code{TRUE}) or loaded on-demand (if \code{FALSE}). \cr \code{assets_ignore} \tab \tab Character. A regular expression, to match assets to omit from immediate loading. Ignored files will still be served if specifically requested. You cannot use this to prevent access to sensitive files. \cr \code{serve_locally} \tab \tab Whether to serve HTML dependencies locally or remotely (via URL).\cr +\code{meta_tags} \tab \tab List of lists. HTML \code{}tags to be added to the index page. +Each list element should have the attributes and values for one tag, eg: +\code{list(name = 'description', content = 'My App')}.\cr \code{routes_pathname_prefix} \tab \tab a prefix applied to the backend routes.\cr \code{requests_pathname_prefix} \tab \tab a prefix applied to request endpoints made by Dash's front-end.\cr @@ -136,6 +142,8 @@ to the \code{ignite()} method of the \link[fiery:Fire]{fiery::Fire} server. \examples{ \dontrun{ +library(dashCoreComponents) +library(dashHtmlComponents) library(dash) app <- Dash$new() app$layout( diff --git a/man/dash-package.Rd b/man/dash-package.Rd index d4c2af3d..f17d0269 100644 --- a/man/dash-package.Rd +++ b/man/dash-package.Rd @@ -20,7 +20,7 @@ Dash is an open source package, released under the permissive MIT license. Plotl \seealso{ Useful links: \itemize{ - \item \url{http://dashr-docs.herokuapp.com} + \item \url{http://dashr.plot.ly} \item \url{https://github.com/plotly/dashR} \item Report bugs at \url{https://github.com/plotly/dashR/issues} }