diff --git a/DESCRIPTION b/DESCRIPTION index 59fae86..e6384e7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,9 +2,11 @@ Package: multiverse.internals Title: Internal Infrastructure for R-multiverse Description: R-multiverse requires this internal infrastructure package to automate contribution reviews and populate universes. -Version: 0.2.14.9000 +Version: 0.2.15 License: MIT + file LICENSE -URL: https://github.com/r-multiverse/multiverse.internals +URL: + https://r-multiverse.org/multiverse.internals, + https://github.com/r-multiverse/multiverse.internals BugReports: https://github.com/r-multiverse/multiverse.internals/issues Authors@R: c( person( diff --git a/NAMESPACE b/NAMESPACE index d1bd510..ad4ab73 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ export(assert_cran_url) export(assert_package) export(assert_release_exists) export(get_current_versions) +export(interpret_issue) export(issues_checks) export(issues_dependencies) export(issues_descriptions) diff --git a/NEWS.md b/NEWS.md index 4815e2a..a48c009 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ -# multiverse.internals 0.2.14.9000 (development) +# multiverse.internals 0.2.16 +* Add `interpret_issue()` to help create RSS feeds. * Add `record_nonstandard_licenses()` # multiverse.internals 0.2.14 diff --git a/R/interpret_issue.R b/R/interpret_issue.R new file mode 100644 index 0000000..b8907ef --- /dev/null +++ b/R/interpret_issue.R @@ -0,0 +1,151 @@ +#' @title Interpret a set of package issues +#' @export +#' @family issues +#' @description Summarize the issues of a package in human-readable text. +#' @return A character string summarizing the issues of a package in prose. +#' @param path Character string, file path to a JSON issue file +#' of a package. +interpret_issue <- function(path) { + package <- basename(path) + if (!file.exists(path)) { + return(paste("Package", package, "has no recorded issues.")) + } + issue <- jsonlite::read_json(path, simplifyVector = TRUE) + paste0( + interpret_title(issue, package), + interpret_advisories(issue), + interpret_checks(issue), + interpret_dependencies(issue, package), + interpret_licenses(issue, package), + interpret_remotes(issue), + interpret_versions(issue) + ) +} + +interpret_title <- function(issue, package) { + title <- paste0( + "R-multiverse found issues with package ", + package + ) + if (is.character(issue$version)) { + title <- paste(title, "version", issue$version) + } + if (is.character(issue$remote_hash)) { + title <- paste(title, "remote hash", issue$remote_hash) + } + paste0(title, " on ", issue$date, ".") +} + +interpret_advisories <- function(issue) { + advisories <- issue$descriptions$advisories + if (is.null(advisories)) { + return(character(0L)) + } + paste0( + "\n\nFound the following advisories in the ", + "R Consortium Advisory Database:\n\n", + as.character(yaml::as.yaml(advisories)) + ) +} + +interpret_checks <- function(issue) { + checks <- issue$checks + if (is.null(checks)) { + return(character(0L)) + } + paste0( + "\n\nNot all checks succeeded on R-universe. ", + "The following output shows the check status on each platform, ", + "the overall build status, and the ", + "build URL. Visit the build URL for specific details ", + "on the check failures.\n\n", + as.character(yaml::as.yaml(checks)) + ) +} + +interpret_dependencies <- function(issue, package) { + dependencies <- issue$dependencies + if (is.null(dependencies)) { + return(character(0L)) + } + direct <- names(dependencies)[lengths(dependencies) < 1L] + indirect <- setdiff(names(dependencies), direct) + text <- paste0( + "\n\nOne or more dependencies have issues. Packages ", + paste(names(dependencies), collapse = ", "), + " are causing problems upstream. " + ) + if (length(direct)) { + text <- paste0( + text, + ifelse(length(direct) == 1L, "Dependency ", "Dependencies "), + paste(direct, collapse = ", "), + ifelse(length(direct) == 1L, " is ", " are "), + "explicitly mentioned in 'Depends:', 'Imports:', or 'LinkingTo:' ", + "in the DESCRIPTION of ", + package, + ". " + ) + } + if (length(indirect)) { + text <- paste0( + text, + ifelse(length(indirect) == 1L, "Package ", "Packages "), + paste(indirect, collapse = ", "), + ifelse(length(indirect) == 1L, " is ", " are "), + "not part of 'Depends:', 'Imports:', or 'LinkingTo:' ", + "in the DESCRIPTION of ", + package, + ", but ", + ifelse(length(indirect) == 1L, "it is", "they are"), + " upstream of one or more direct dependencies:\n\n", + as.character(yaml::as.yaml(dependencies[indirect])) + ) + } + text +} + +interpret_licenses <- function(issue, package) { + license <- issue$descriptions$license + if (is.null(license)) { + return(character(0L)) + } + paste( + "\n\nPackage", + package, + "declares license", + shQuote(license), + "in its DESCRIPTION file. R-multiverse cannot verify that", + "this license is a valid free and open-source license", + "(c.f. https://en.wikipedia.org/wiki/Free_and_open-source_software).", + "Each package contributed to R-multiverse must have a valid", + "open-source license to protect the intellectual property", + "rights of the package owners." + ) +} + +interpret_remotes <- function(issue) { + remotes <- issue$descriptions$remotes + if (is.null(remotes)) { + return(character(0L)) + } + paste0( + "\n\nPackage releases should not use the 'Remotes:' field. Found:", + as.character(yaml::as.yaml(remotes)) + ) +} + +interpret_versions <- function(issue) { + versions <- issue$versions + if (is.null(versions)) { + return(character(0L)) + } + paste0( + "\n\nThe version number of the current release ", + "should be highest version of all the releases so far. ", + "Here is the current version of the package, ", + "the highest version number ever recorded by R-multiverse, ", + "and the latest remote hash of each:\n\n", + as.character(yaml::as.yaml(versions)) + ) +} diff --git a/R/issues_descriptions.R b/R/issues_descriptions.R index a25e5fc..a061a97 100644 --- a/R/issues_descriptions.R +++ b/R/issues_descriptions.R @@ -1,14 +1,13 @@ -#' @title Report `DESCRIPTION` file issues. +#' @title Report `DESCRIPTION`-level issues. #' @export #' @family issues -#' @description Report issues with the `DESCRIPTION` files of packages. -#' @details [issues_descriptions()] scans downloaded metadata from the -#' `PACKAGES.json` file of an R universe and scans for specific issues in a -#' package's description file: -#' 1. The presence of a `"Remotes"` field. -#' 2. There is a security advisory at -#' -#' for the given package version. +#' @description Report issues with `DESCRIPTION`-level metadata of packages. +#' @details [issues_descriptions()] reports specific issues in the +#' `DESCRIPTION`-level metadata of packages: +#' 1. Security advisories at +#' . +#' 2. Licenses that cannot be verified as free and open-source. +#' 3. The presence of a `"Remotes"` field. #' @inheritSection record_issues Package issues #' @return A named list of information about packages which do not comply #' with `DESCRPTION` checks. Each name is a package name, @@ -23,9 +22,10 @@ issues_descriptions <- function(meta = meta_packages()) { meta$issue <- FALSE meta <- issues_descriptions_advisories(meta) + meta <- issues_descriptions_licenses(meta) meta <- issues_descriptions_remotes(meta) meta <- meta[meta$issue,, drop = FALSE] # nolint - issues_list(meta[, c("package", "advisories", "remotes")]) + issues_list(meta[, c("package", "advisories", "license", "remotes")]) } issues_descriptions_advisories <- function(meta) { @@ -41,6 +41,12 @@ issues_descriptions_advisories <- function(meta) { meta } +issues_descriptions_licenses <- function(meta) { + meta$license[meta$foss] <- NA_character_ + meta$issue <- meta$issue | !meta$foss + meta +} + issues_descriptions_remotes <- function(meta) { meta[["remotes"]] <- meta[["remotes"]] %||% replicate(nrow(meta), NULL) meta$remotes <- lapply(meta$remotes, function(x) x[nzchar(x)]) diff --git a/R/meta_packages.R b/R/meta_packages.R index 7d66486..d5ded54 100644 --- a/R/meta_packages.R +++ b/R/meta_packages.R @@ -8,9 +8,10 @@ #' @examples #' meta_packages(repo = "https://wlandau.r-universe.dev") meta_packages <- function(repo = "https://community.r-multiverse.org") { - fields <- c("Version", "Remotes", "RemoteSha") + repo <- trim_url(repo) + fields <- c("Version", "License", "Remotes", "RemoteSha") listing <- file.path( - utils::contrib.url(trim_url(repo), type = "source"), + utils::contrib.url(repos = repo, type = "source"), paste0("PACKAGES.json?fields=", paste(fields, collapse = ",")) ) out <- jsonlite::stream_in( @@ -22,5 +23,8 @@ meta_packages <- function(repo = "https://community.r-multiverse.org") { ) colnames(out) <- tolower(colnames(out)) rownames(out) <- out$package + foss <- utils::available.packages(repos = repo, filters = "license/FOSS") + out$foss <- FALSE + out[as.character(foss[, "Package"]), "foss"] <- TRUE out } diff --git a/_pkgdown.yml b/_pkgdown.yml index 42ee524..7ac02a8 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -24,6 +24,9 @@ reference: - record_issues - record_nonstandard_licenses - record_versions +- title: Communicate issues + contents: + - interpret_issue - title: Staging contents: - update_staging diff --git a/man/interpret_issue.Rd b/man/interpret_issue.Rd new file mode 100644 index 0000000..b8fc549 --- /dev/null +++ b/man/interpret_issue.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/interpret_issue.R +\name{interpret_issue} +\alias{interpret_issue} +\title{Interpret a set of package issues} +\usage{ +interpret_issue(path) +} +\arguments{ +\item{path}{Character string, file path to a JSON issue file +of a package.} +} +\value{ +A character string summarizing the issues of a package in prose. +} +\description{ +Summarize the issues of a package in human-readable text. +} +\seealso{ +Other issues: +\code{\link{issues_checks}()}, +\code{\link{issues_dependencies}()}, +\code{\link{issues_descriptions}()}, +\code{\link{issues_versions}()} +} +\concept{issues} diff --git a/man/issues_checks.Rd b/man/issues_checks.Rd index 25040be..c261e25 100644 --- a/man/issues_checks.Rd +++ b/man/issues_checks.Rd @@ -44,6 +44,7 @@ together all the issues about R-multiverse packages. } \seealso{ Other issues: +\code{\link{interpret_issue}()}, \code{\link{issues_dependencies}()}, \code{\link{issues_descriptions}()}, \code{\link{issues_versions}()} diff --git a/man/issues_dependencies.Rd b/man/issues_dependencies.Rd index c54616a..1543159 100644 --- a/man/issues_dependencies.Rd +++ b/man/issues_dependencies.Rd @@ -64,6 +64,7 @@ together all the issues about R-multiverse packages. } \seealso{ Other issues: +\code{\link{interpret_issue}()}, \code{\link{issues_checks}()}, \code{\link{issues_descriptions}()}, \code{\link{issues_versions}()} diff --git a/man/issues_descriptions.Rd b/man/issues_descriptions.Rd index 0af48ac..668364b 100644 --- a/man/issues_descriptions.Rd +++ b/man/issues_descriptions.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/issues_descriptions.R \name{issues_descriptions} \alias{issues_descriptions} -\title{Report \code{DESCRIPTION} file issues.} +\title{Report \code{DESCRIPTION}-level issues.} \usage{ issues_descriptions(meta = meta_packages()) } @@ -17,17 +17,16 @@ and each element contains specific information about non-compliance. } \description{ -Report issues with the \code{DESCRIPTION} files of packages. +Report issues with \code{DESCRIPTION}-level metadata of packages. } \details{ -\code{\link[=issues_descriptions]{issues_descriptions()}} scans downloaded metadata from the -\code{PACKAGES.json} file of an R universe and scans for specific issues in a -package's description file: +\code{\link[=issues_descriptions]{issues_descriptions()}} reports specific issues in the +\code{DESCRIPTION}-level metadata of packages: \enumerate{ +\item Security advisories at +\url{https://github.com/RConsortium/r-advisory-database}. +\item Licenses that cannot be verified as free and open-source. \item The presence of a \code{"Remotes"} field. -\item There is a security advisory at -\url{https://github.com/RConsortium/r-advisory-database} -for the given package version. } } \section{Package issues}{ @@ -49,6 +48,7 @@ together all the issues about R-multiverse packages. } \seealso{ Other issues: +\code{\link{interpret_issue}()}, \code{\link{issues_checks}()}, \code{\link{issues_dependencies}()}, \code{\link{issues_versions}()} diff --git a/man/issues_versions.Rd b/man/issues_versions.Rd index 50e160d..e84f705 100644 --- a/man/issues_versions.Rd +++ b/man/issues_versions.Rd @@ -79,6 +79,7 @@ together all the issues about R-multiverse packages. } \seealso{ Other issues: +\code{\link{interpret_issue}()}, \code{\link{issues_checks}()}, \code{\link{issues_dependencies}()}, \code{\link{issues_descriptions}()} diff --git a/tests/testthat/helper-mock.R b/tests/testthat/helper-mock.R index 32e66b1..37d6243 100644 --- a/tests/testthat/helper-mock.R +++ b/tests/testthat/helper-mock.R @@ -144,7 +144,7 @@ mock_meta_packages <- structure( "BSD_3_clause + file LICENSE", "MIT + file LICENSE", "GPL (>= 2)", "GPL (>= 3)", "GPL (>= 3)", "MIT + file LICENSE", "MIT + file LICENSE", "GPL (>= 3)", "MIT + file LICENSE", "GPL (>= 3)", "MIT + file LICENSE", - "MIT + file LICENSE", "MIT + file LICENSE", "MIT + file LICENSE", + "MIT + file LICENSE", "non-standard", "MIT + file LICENSE", "MIT + file LICENSE", "GPL-3", "MIT + file LICENSE" ), remotesha = c( @@ -574,7 +574,7 @@ mock_meta_packages <- structure( ) ), distro = c( - "noble", "noble", "noble", "noble", "noble", + "noble", "noble", "noble", "noble", "nomock_meta_packages_graphble", "noble", "noble", "noble", "noble", "noble", "noble", "noble", "noble", "noble", "noble", "noble", "noble", "noble", "noble", "noble" @@ -584,7 +584,8 @@ mock_meta_packages <- structure( NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, c("hyunjimoon/SBC", "stan-dev/cmdstanr", ""), NULL, NULL, "markvanderloo/tinytest/pkg", NULL, NULL, NULL - ) + ), + foss = c(rep(TRUE, 15L), FALSE, rep(TRUE, 4L)) ), class = "data.frame", row.names = c(NA, 20L) @@ -714,7 +715,8 @@ mock_meta_packages_graph <- structure( row.names = c(NA, 5L) ) ), - distro = c("noble", "noble", "noble", "noble", "noble") + distro = c("noble", "noble", "noble", "noble", "noble"), + foss = rep(TRUE, 5L) ), class = "data.frame", row.names = c(NA, 5L) diff --git a/tests/testthat/test-interpret_issue.R b/tests/testthat/test-interpret_issue.R new file mode 100644 index 0000000..54a91a5 --- /dev/null +++ b/tests/testthat/test-interpret_issue.R @@ -0,0 +1,238 @@ +test_that("interpret_issue() with no problems", { + expect_equal( + interpret_issue("abc"), + "Package abc has no recorded issues." + ) +}) + +test_that("interpret_issue() with advisories", { + skip_if_offline() + mock <- mock_meta_packages + for (field in c("_id", "_dependencies", "distro", "remotes")) { + mock[[field]] <- NULL + } + example <- mock$package == "nanonext" + commonmark <- mock[example,, drop = FALSE] # nolint + commonmark$package <- "commonmark" + commonmark$version <- "0.2" + readxl <- mock[example,, drop = FALSE] # nolint + readxl$package <- "readxl" + readxl$version <- "1.4.1" + meta <- rbind( + mock[seq_len(nrow(mock)), ], # to suppress a warning + commonmark, + readxl + ) + output <- tempfile() + versions <- tempfile() + record_versions( + versions = versions, + repo = "https://wlandau.r-universe.dev" + ) + on.exit(unlink(c(output, versions), recursive = TRUE)) + record_issues( + mock = list(packages = meta, checks = mock_meta_checks), + output = output, + versions = versions + ) + out <- interpret_issue(file.path(output, "commonmark")) + expect_true( + grepl( + "Found the following advisories in the R Consortium Advisory Database", + out + ) + ) +}) + +test_that("interpret_issue() with bad licenses", { + skip_if_offline() + mock <- mock_meta_packages[mock_meta_packages$package == "targetsketch", ] + output <- tempfile() + versions <- tempfile() + record_versions( + versions = versions, + repo = "https://wlandau.r-universe.dev" + ) + on.exit(unlink(c(output, versions), recursive = TRUE)) + record_issues( + mock = list(packages = mock, checks = mock_meta_checks), + output = output, + versions = versions + ) + out <- interpret_issue(file.path(output, "targetsketch")) + expect_true( + grepl( + "targetsketch declares license", + out + ) + ) +}) + +test_that("interpret_issue() checks etc.", { + skip_if_offline() + output <- tempfile() + lines <- c( + "[", + " {", + " \"package\": \"constantversion\",", + " \"version_current\": \"1.0.0\",", + " \"hash_current\": \"hash_1.0.0-modified\",", + " \"version_highest\": \"1.0.0\",", + " \"hash_highest\": \"hash_1.0.0\"", + " }", + "]" + ) + versions <- tempfile() + writeLines(lines, versions) + on.exit(unlink(c(output, versions), recursive = TRUE)) + record_issues( + mock = list(packages = mock_meta_packages, checks = mock_meta_checks), + output = output, + versions = versions + ) + expect_true( + grepl( + "Not all checks succeeded on R-universe", + interpret_issue(file.path(output, "INLA")) + ) + ) + expect_true( + grepl( + "Not all checks succeeded on R-universe", + interpret_issue(file.path(output, "polars")) + ) + ) + expect_true( + grepl( + "Package releases should not use the 'Remotes:' field", + interpret_issue(file.path(output, "audio.whisper")), + fixed = TRUE + ) + ) + expect_true( + grepl( + "bnosac/audio.vadwebrtc", + interpret_issue(file.path(output, "audio.whisper")), + fixed = TRUE + ) + ) + expect_true( + grepl( + "One or more dependencies have issues", + interpret_issue(file.path(output, "tidypolars")) + ) + ) + expect_true( + grepl( + "The version number of the current release should be highest version", + interpret_issue(file.path(output, "constantversion")) + ) + ) +}) + +test_that("interpret_issue() with complicated dependency problems", { + output <- tempfile() + lines <- c( + "[", + " {", + " \"package\": \"nanonext\",", + " \"version_current\": \"1.0.0\",", + " \"hash_current\": \"hash_1.0.0-modified\",", + " \"version_highest\": \"1.0.0\",", + " \"hash_highest\": \"hash_1.0.0\"", + " }", + "]" + ) + versions <- tempfile() + on.exit(unlink(c(output, versions), recursive = TRUE)) + writeLines(lines, versions) + meta_checks <- mock_meta_checks[1L, ] + meta_checks$package <- "crew" + meta_checks[["_winbinary"]] <- "failure" + suppressMessages( + record_issues( + versions = versions, + mock = list( + checks = meta_checks, + packages = mock_meta_packages_graph, + today = "2024-01-01" + ), + output = output, + verbose = TRUE + ) + ) + expect_true(dir.exists(output)) + expect_equal( + jsonlite::read_json( + file.path(output, "nanonext"), + simplifyVector = TRUE + ), + list( + versions = list( + version_current = "1.0.0", + hash_current = "hash_1.0.0-modified", + version_highest = "1.0.0", + hash_highest = "hash_1.0.0" + ), + date = "2024-01-01", + version = "1.1.0.9000", + remote_hash = "85dd672a44a92c890eb40ea9ebab7a4e95335c2f" + ) + ) + expect_equal( + jsonlite::read_json( + file.path(output, "mirai"), + simplifyVector = TRUE + ), + list( + dependencies = list( + nanonext = list() + ), + date = "2024-01-01", + version = "1.1.0.9000", + remote_hash = "7015695b7ef82f82ab3225ac2d226b2c8f298097" + ) + ) + expect_equal( + jsonlite::read_json( + file.path(output, "crew"), + simplifyVector = TRUE + ), + list( + checks = list( + "_linuxdevel" = "success", + "_macbinary" = "success", + "_winbinary" = "failure", + "_status" = "success", + "_buildurl" = file.path( + "https://github.com/r-universe/r-multiverse/actions", + "runs/9412009683" + ) + ), + dependencies = list( + nanonext = "mirai" + ), + date = "2024-01-01", + version = "0.9.3.9002", + remote_hash = "eafad0276c06dec2344da2f03596178c754c8b5e" + ) + ) + expect_true( + grepl( + "\nnanonext: mirai\n", + interpret_issue(file.path(output, "crew")) + ) + ) + expect_true( + grepl( + "\nnanonext: crew\n", + interpret_issue(file.path(output, "crew.aws.batch")) + ) + ) + expect_true( + grepl( + "Dependency nanonext is explicitly mentioned in", + interpret_issue(file.path(output, "mirai")) + ) + ) +}) diff --git a/tests/testthat/test-issues_descriptions.R b/tests/testthat/test-issues_descriptions.R index 0fac6f3..618777c 100644 --- a/tests/testthat/test-issues_descriptions.R +++ b/tests/testthat/test-issues_descriptions.R @@ -5,6 +5,7 @@ test_that("issues_descriptions() mocked", { stantargets = list( remotes = c("hyunjimoon/SBC", "stan-dev/cmdstanr") ), + targetsketch = list(license = "non-standard"), tidypolars = list(remotes = "markvanderloo/tinytest/pkg") ) expect_equal(issues, expected) @@ -24,7 +25,11 @@ test_that("issues_descriptions() with security advisories", { readxl <- mock_meta_packages[example,, drop = FALSE] # nolint readxl$package <- "readxl" readxl$version <- "1.4.1" - meta <- rbind(mock_meta_packages, commonmark, readxl) + meta <- rbind( + mock_meta_packages, + commonmark, + readxl + ) out <- issues_descriptions(meta) exp <- list( audio.whisper = list(remotes = "bnosac/audio.vadwebrtc"), @@ -42,6 +47,7 @@ test_that("issues_descriptions() with security advisories", { ) ), stantargets = list(remotes = c("hyunjimoon/SBC", "stan-dev/cmdstanr")), + targetsketch = list(license = "non-standard"), tidypolars = list(remotes = "markvanderloo/tinytest/pkg") ) expect_equal(out, exp) diff --git a/tests/testthat/test-record_issues.R b/tests/testthat/test-record_issues.R index 1482188..a6fc51e 100644 --- a/tests/testthat/test-record_issues.R +++ b/tests/testthat/test-record_issues.R @@ -19,6 +19,7 @@ test_that("record_issues() mocked", { "polars", "SBC", "stantargets", + "targetsketch", "tidypolars", "tidytensor", "version_decremented", @@ -63,6 +64,20 @@ test_that("record_issues() mocked", { remote_hash = "bbdda1b4a44a3d6a22041e03eed38f27319d8f32" ) ) + expect_equal( + jsonlite::read_json( + file.path(output, "targetsketch"), + simplifyVector = TRUE + ), + list( + descriptions = list( + license = "non-standard" + ), + date = "2024-01-01", + version = "0.0.1", + remote_hash = "a199a734b16f91726698a19e5f147f57f79cb2b6" + ) + ) expect_equal( jsonlite::read_json( file.path(output, "version_decremented"), @@ -190,6 +205,7 @@ test_that("record_issues() with dependency problems", { "]" ) versions <- tempfile() + on.exit(unlink(c(output, versions), recursive = TRUE)) writeLines(lines, versions) meta_checks <- mock_meta_checks[1L, ] meta_checks$package <- "crew"