Export R shinylive apps with Wasm package binaries included in static…

… assets (#72)

* Update webR and shinylive versions

* Compute and download Wasm binaries on export

* Update DESCRIPTION and documentation

* Update quarto_ext.R for Wasm binaries with Quarto

* Misc namespace and imports fixes

* Fix app-resources test

* Warn about missing packages, rather than abort

Even with some missing dependencies, an app may work correctly. For
example, the `curl` package could be a dependency of a used Wasm
package, but if network functionality is avoided never actually used at
runtime.

So for missing packages installed locally from a CRAN-like repo, we
issue a warning and only include the package without any Wasm assets.

For GitHub packages we are still strict and require that the package
exists.

* Apply suggestions from code review

Co-authored-by: Barret Schloerke <barret@posit.co>

* Apply suggestions from code review

Co-authored-by: Barret Schloerke <barret@posit.co>

* Switch to pkgdepends::new_pkg_deps()

* Update SHINYLIVE_ASSETS_VERSION

---------

Co-authored-by: Barret Schloerke <barret@posit.co>

DESCRIPTION

@@ -18,12 +18,17 @@ BugReports: https://github.com/posit-dev/r-shinylive/issues
 URL: https://posit-dev.github.io/r-shinylive/, https://github.com/posit-dev/r-shinylive
 Imports:
     archive,
+    base64enc,
     brio,
     fs,
+    glue,
+    gh,
     httr2 (>= 1.0.0),
     jsonlite,
+    pkgdepends,
     progress,
     rappdirs,
+    renv,
     rlang,
     tools
 Suggests:

R/export.R

@@ -8,6 +8,10 @@
 #' @param subdir Subdirectory of `destdir` to write the app to.
 #' @param verbose Print verbose output. Defaults to `TRUE` if running
 #'    interactively.
+#' @param wasm_packages Download and include binary WebAssembly packages as
+#'    part of the output app's static assets. Defaults to `TRUE`.
+#' @param package_cache Cache downloaded binary WebAssembly packages. Defaults
+#'    to `TRUE`.
 #' @param ... Ignored
 #' @export
 #' @return Nothing. The app is exported to `destdir`. Instructions for serving
@@ -29,7 +33,9 @@ export <- function(
     destdir,
     ...,
     subdir = "",
-    verbose = is_interactive()) {
+    verbose = is_interactive(),
+    wasm_packages = TRUE,
+    package_cache = TRUE) {
   verbose_print <- if (verbose) message else list
 
   stopifnot(fs::is_dir(appdir))
@@ -70,10 +76,10 @@ export <- function(
   base_files <- c(shinylive_common_files("base"), shinylive_common_files("r"))
   if (verbose) {
     p <- progress::progress_bar$new(
-      format = "[:bar] :percent",
+      format = "[:bar] :percent\n",
       total = length(base_files),
-      clear = TRUE,
-      # show_after = 0
+      clear = FALSE,
+      show_after = 0
     )
   }
   Map(
@@ -139,6 +145,13 @@ export <- function(
 
   #     copy_fn(src_path, dest_path)
 
+  # =========================================================================
+  # Copy app package dependencies as Wasm binaries
+  # =========================================================================
+  if (wasm_packages) {
+    download_wasm_packages(appdir, destdir, verbose, package_cache)
+  }
+
   # =========================================================================
   # For each app, write the index.html, edit/index.html, and app.json in
   # destdir/subdir.

R/packages.R

@@ -0,0 +1,277 @@
+# Resolve package list hard dependencies
+resolve_dependencies <- function(pkgs, verbose) {
+  pkg_refs <- find.package(pkgs, lib.loc = NULL, quiet = FALSE, verbose)
+  pkg_refs <- glue::glue("local::{pkg_refs}")
+  inst <- pkgdepends::new_pkg_deps(pkg_refs)
+  inst$resolve()
+  unique(inst$get_resolution()$package)
+}
+
+get_default_wasm_assets <- function(desc) {
+  pkg <- desc$Package
+  r_wasm <- "http://repo.r-wasm.org"
+  # TODO: Restore the use of short version, once webR with R 4.4.0 is released.
+  #       This function can then be merged with `get_r_universe_wasm_assets()`
+  r_short <- WEBR_R_VERSION
+  contrib <- glue::glue("{r_wasm}/bin/emscripten/contrib/{r_short}")
+
+  info <- utils::available.packages(contriburl = contrib)
+  if (!pkg %in% rownames(info)) {
+    rlang::warn(c(
+      glue::glue("Can't find \"{pkg}\" in webR binary repository.")
+    ))
+    return(list())
+  }
+  ver <- info[pkg, "Version", drop = TRUE]
+
+  # Show a warning if packages major.minor versions differ
+  # We don't worry too much about patch, since webR versions of packages may be
+  # patched at the repo for compatibility with Emscripten
+  inst_ver <- package_version(desc$Version)
+  repo_ver <- package_version(ver)
+  if (inst_ver$major != repo_ver$major || inst_ver$minor != repo_ver$minor) {
+    rlang::warn(c(
+      glue::glue("Package version mismatch for \"{pkg}\", ensure the versions below are compatible."),
+      "!" = glue::glue("Installed version: {desc$Version}, WebAssembly version: {ver}."),
+      "i" = "Install a package version matching the WebAssembly version to silence this error."
+    ))
+  }
+
+  list(
+    list(
+      filename = glue::glue("{pkg}_{ver}.data"),
+      url = glue::glue("{contrib}/{pkg}_{ver}.data")
+    ),
+    list(
+      filename = glue::glue("{pkg}_{ver}.js.metadata"),
+      url = glue::glue("{contrib}/{pkg}_{ver}.js.metadata")
+    )
+  )
+}
+
+get_r_universe_wasm_assets <- function(desc) {
+  pkg <- desc$Package
+  r_universe <- desc$Repository
+  r_short <- gsub("\\.[^.]+$", "", WEBR_R_VERSION)
+  contrib <- glue::glue("{r_universe}/bin/emscripten/contrib/{r_short}")
+
+  info <- utils::available.packages(contriburl = contrib)
+  if (!pkg %in% rownames(info)) {
+    rlang::warn(c(
+      glue::glue("Can't find \"{pkg}\" in r-universe binary repository.")
+    ))
+    return(list())
+  }
+  ver <- info[pkg, "Version", drop = TRUE]
+
+  # Show a warning if packages major.minor versions differ
+  # We don't worry too much about patch, since webR versions of packages may be
+  # patched at the repo for compatibility with Emscripten
+  inst_ver <- package_version(desc$Version)
+  repo_ver <- package_version(ver)
+  if (inst_ver$major != repo_ver$major || inst_ver$minor != repo_ver$minor) {
+    rlang::warn(c(
+      glue::glue("Package version mismatch for \"{pkg}\", ensure the versions below are compatible."),
+      "!" = glue::glue("Installed version: {desc$Version}, WebAssembly version: {ver}."),
+      "i" = "Install a package version matching the WebAssembly version to silence this error."
+    ))
+  }
+
+  list(
+    list(
+      filename = glue::glue("{pkg}_{ver}.data"),
+      url = glue::glue("{contrib}/{pkg}_{ver}.data")
+    ),
+    list(
+      filename = glue::glue("{pkg}_{ver}.js.metadata"),
+      url = glue::glue("{contrib}/{pkg}_{ver}.js.metadata")
+    )
+  )
+}
+
+get_github_wasm_assets <- function(desc) {
+  pkg <- desc$Package
+  user <- desc$RemoteUsername
+  repo <- desc$RemoteRepo
+  ref <- desc$RemoteRef
+
+  # Find a release for installed package's RemoteRef
+  tags <- tryCatch(
+    gh::gh("/repos/{user}/{repo}/releases/tags/{ref}",
+      user = user, repo = repo, ref = ref
+    ),
+    error = function(err) {
+      rlang::abort(c(
+        glue::glue("Can't find GitHub release for github::{user}/{repo}@{ref}"),
+        "!" = glue::glue("Ensure a GitHub release exists for the package repository reference: \"{ref}\"."),
+        "i" = "Alternatively, install a CRAN version of this package to use the default Wasm binary repository."
+      ), parent = err)
+    }
+  )
+
+  # Find GH release asset URLs for R library VFS image
+  library_data <- Filter(function(item) {
+    item$name == "library.data"
+  }, tags$assets)
+  library_metadata <- Filter(function(item) {
+    item$name == "library.js.metadata"
+  }, tags$assets)
+
+  if (length(library_data) == 0 || length(library_metadata) == 0) {
+    # We are stricter here than with CRAN-like repositories, the asset bundle
+    # `RemoteRef` must match exactly. This allows for the use of development
+    # versions of packages through the GitHub pre-releases feature.
+    rlang::abort(c(
+      glue::glue("Can't find WebAssembly binary assets for github::{user}/{repo}@{ref}"),
+      "!" = glue::glue("Ensure WebAssembly binary assets are associated with the GitHub release \"{ref}\"."),
+      "i" = "WebAssembly binary assets can be built on release using GitHub Actions: https://github.com/r-wasm/actions",
+      "i" = "Alternatively, install a CRAN version of this package to use the default Wasm binary repository."
+    ))
+  }
+
+  list(
+    list(
+      filename = library_data[[1]]$name,
+      url = library_data[[1]]$browser_download_url
+    ),
+    list(
+      filename = library_metadata[[1]]$name,
+      url = library_metadata[[1]]$browser_download_url
+    )
+  )
+}
+
+# Lookup URL and metadata for Wasm binary package
+prepare_wasm_metadata <- function(pkg, metadata, verbose) {
+  desc <- utils::packageDescription(pkg)
+  repo <- desc$Repository
+  prev_ref <- metadata$ref
+  prev_cached <- metadata$cached
+  metadata$name <- pkg
+  metadata$version <- desc$Version
+
+  # Skip base R packages
+  if (!is.null(desc$Priority) && desc$Priority == "base") {
+    metadata$ref <- glue::glue("{metadata$name}@{metadata$version}")
+    metadata$type <- "base"
+    metadata$cached <- prev_cached <- TRUE
+    if (verbose) {
+      message("Skipping base R package: ", metadata$ref)
+    }
+    return(metadata)
+  }
+
+  # Set a package ref for caching
+  if (!is.null(desc$RemoteType) && desc$RemoteType == "github") {
+    user <- desc$RemoteUsername
+    repo <- desc$RemoteRepo
+    sha <- desc$RemoteSha
+    metadata$ref <- glue::glue("github::{user}/{repo}@{sha}")
+  } else if (repo == "CRAN") {
+    metadata$ref <- glue::glue("{metadata$name}@{metadata$version}")
+  } else if (grepl("Bioconductor", repo)) {
+    metadata$ref <- glue::glue("bioc::{metadata$name}@{metadata$version}")
+  } else if (grepl("r-universe\\.dev$", repo)) {
+    metadata$ref <- glue::glue("{repo}::{metadata$name}@{desc$RemoteSha}")
+  } else {
+    metadata$ref <- glue::glue("{metadata$name}@{metadata$version}")
+  }
+
+  # If not cached, discover Wasm binary URLs
+  if (is.null(prev_cached) || !prev_cached || prev_ref != metadata$ref) {
+    metadata$cached <- FALSE
+    if (!is.null(desc$RemoteType) && desc$RemoteType == "github") {
+      metadata$assets <- get_github_wasm_assets(desc)
+      metadata$type <- "library"
+    } else if (grepl("r-universe\\.dev$", repo)) {
+      metadata$assets <- get_r_universe_wasm_assets(desc)
+      metadata$type <- "package"
+    } else {
+      # Fallback to repo.r-wasm.org lookup for CRAN and anything else
+      metadata$assets <- get_default_wasm_assets(desc)
+      metadata$type <- "package"
+    }
+  } else if (verbose) {
+    message("Skipping cached Wasm binary: ", metadata$ref)
+  }
+
+  metadata
+}
+
+download_wasm_packages <- function(appdir, destdir, verbose, package_cache) {
+  verbose_print <- if (verbose) message else list
+  # App dependencies, ignoring shiny packages in base webR image
+  pkgs <- unique(renv::dependencies(appdir, quiet = !verbose)$Package)
+  pkgs <- pkgs[pkgs != "shiny" & pkgs != "bslib"]
+  if (length(pkgs) > 0) {
+    pkgs <- resolve_dependencies(pkgs, verbose)
+  }
+
+  if (verbose) {
+    p <- progress::progress_bar$new(
+      format = "[:bar] :percent\n",
+      total = length(pkgs),
+      clear = TRUE,
+      show_after = 0
+    )
+  }
+
+  # Create empty R packages directory in app assets if not already there
+  pkg_dir <- fs::path(destdir, "shinylive", "webr", "packages")
+  fs::dir_create(pkg_dir, recurse = TRUE)
+
+  verbose_print(
+    "Downloading WebAssembly R package binaries to ", pkg_dir, "/"
+  )
+
+  # Load existing metadata from disk, from a previously deployed app
+  metadata_file <- fs::path(destdir, "shinylive", "webr", "packages", "metadata.rds")
+  prev_metadata <- if (package_cache && fs::file_exists(metadata_file)) {
+    readRDS(metadata_file)
+  } else {
+    list()
+  }
+
+  # Loop over packages and download them if not cached
+  names(pkgs) <- pkgs
+  cur_metadata <- lapply(pkgs, function(pkg) {
+    if (verbose) p$tick()
+
+    pkg_subdir <- fs::path(pkg_dir, pkg)
+    fs::dir_create(pkg_subdir, recurse = TRUE)
+
+    prev_meta <- if (pkg %in% names(prev_metadata)) {
+      prev_metadata[[pkg]]
+    } else {
+      list()
+    }
+    # Create package ref and lookup download URLs
+    meta <- prepare_wasm_metadata(pkg, prev_meta, verbose)
+
+    if (!meta$cached && length(meta$assets) > 0) {
+      # Download Wasm binaries and copy to static assets dir
+      for (file in meta$assets) {
+        utils::download.file(file$url, fs::path(pkg_subdir, file$filename))
+      }
+      meta$cached <- TRUE
+      meta$path <- glue::glue("packages/{pkg}/{meta$assets[[1]]$filename}")
+    }
+    meta
+  })
+
+  # Merge metadata to protect previous cache
+  pkgs <- unique(c(names(prev_metadata), names(cur_metadata)))
+  metadata <- Map(
+    function(a, b) if (is.null(b)) a else b,
+    prev_metadata[pkgs],
+    cur_metadata[pkgs]
+  )
+  names(metadata) <- pkgs
+
+  # Remove base packages from caching and metadata
+  metadata <- Filter(function(item) item$type != "base", metadata)
+
+  verbose_print("Writing app metadata to ", metadata_file, appendLF = FALSE)
+  saveRDS(metadata, metadata_file)
+  verbose_print(": ", fs::file_info(metadata_file)$size[1], " bytes")
+}