Break up into smaller functions and add some tests

R/external-assets.R

@@ -3,36 +3,10 @@ assemble_ext_assets <- function(pkg) {
   deps_ext <- yaml::read_yaml(path_assets_yaml)
 
   purrr::map_chr(deps_ext, ~ {
-    # download external resource
     path <- path_deps(pkg, basename(.x$url))
     download.file(.x$url, path, quiet = TRUE, mode = "wb")
+    check_integrity(path, .x$integrity)
 
-    # check file integrity
-    sha_size <- as.integer(regmatches(
-      .x$integrity,
-      regexpr("(?<=^sha)\\d{3}", .x$integrity, perl = TRUE)
-    ))
-    if (!(sha_size %in% c(256L, 384L, 512L))) {
-      cli::cli_abort(paste0(
-        "Invalid {.field integrity} value set in {.file ",
-        "{path_assets_yaml}}: {.val {(.x$integrity)}} Allowed are only ",
-        "SHA-256, SHA-384 and SHA-512."
-      ))
-    }
-    con <- file(path, encoding = "UTF-8")
-    hash <- openssl::base64_encode(openssl::sha2(con, sha_size))
-    hash_target <- regmatches(
-      .x$integrity,
-      regexpr("(?<=^sha\\d{3}-).+", .x$integrity, perl = TRUE)
-    )
-
-    if (hash != hash_target) {
-      cli::cli_abort(paste0(
-        "Hash of downloaded {(.x$type)} asset doesn't match {.field ",
-        "integrity} value of {.val {(.x$integrity)}}. Asset URL is: {.url ",
-        "{(.x$url)}}"
-      ))
-    }
     .x$url <- fs::path_rel(path, pkg$dst_path)
 
     # assemble HTML tag
@@ -44,3 +18,35 @@ assemble_ext_assets <- function(pkg) {
     )
   })
 }
+
+check_integrity <- function(path, integrity) {
+  parsed <- parse_integrity(integrity)
+  if (!parsed$size %in% c(256L, 384L, 512L)) {
+    cli::cli_abort(
+      "{.field integrity} must use SHA-256, SHA-384, or SHA-512",
+      .internal = TRUE
+    )
+  }
+
+  hash <- compute_hash(path, parsed$size)
+  if (hash != parsed$hash) {
+    cli::cli_abort(
+      "Downloaded asset does not match known integrity",
+      .internal = TRUE
+    )
+  }
+
+  invisible()
+}
+
+compute_hash <- function(path, size) {
+  con <- file(path, encoding = "UTF-8")
+  openssl::base64_encode(openssl::sha2(con, size))
+}
+
+parse_integrity <- function(x) {
+  size <- as.integer(regmatches(x, regexpr("(?<=^sha)\\d{3}", x, perl = TRUE)))
+  hash <- regmatches(x, regexpr("(?<=^sha\\d{3}-).+", x, perl = TRUE))
+
+  list(size = size, hash = hash)
+}

tests/testthat/_snaps/external-assets.md

@@ -0,0 +1,17 @@
+# check integrity validates integrity
+
+    Code
+      check_integrity(temp, "sha123-abc")
+    Condition
+      Error in `check_integrity()`:
+      ! integrity must use SHA-256, SHA-384, or SHA-512
+      i This is an internal error that was detected in the pkgdown package.
+        Please report it at <https://github.com/r-lib/pkgdown/issues> with a reprex (<https://tidyverse.org/help/>) and the full backtrace.
+    Code
+      check_integrity(temp, "sha256-abc")
+    Condition
+      Error in `check_integrity()`:
+      ! Downloaded asset does not match known integrity
+      i This is an internal error that was detected in the pkgdown package.
+        Please report it at <https://github.com/r-lib/pkgdown/issues> with a reprex (<https://tidyverse.org/help/>) and the full backtrace.
+

tests/testthat/test-external-assets.R

@@ -0,0 +1,15 @@
+test_that("check integrity validates integrity", {
+  temp <- withr::local_tempfile(lines = letters)
+
+  expect_snapshot(error = TRUE, {
+    check_integrity(temp, "sha123-abc")
+    check_integrity(temp, "sha256-abc")
+  })
+
+  integrity <- paste0("sha256-", compute_hash(temp, 256L))
+  expect_no_error(check_integrity(temp, integrity))
+})
+
+test_that("can parse integrity", {
+  expect_equal(parse_integrity("sha256-abc"), list(size = 256L, hash = "abc"))
+})