Skip to content

Commit

Permalink
handling cran archives starts
Browse files Browse the repository at this point in the history
  • Loading branch information
Bruno Rodrigues committed Aug 2, 2023
1 parent 040d747 commit eeeb1b8
Show file tree
Hide file tree
Showing 11 changed files with 172 additions and 218 deletions.
1 change: 0 additions & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,6 @@ Depends:
Imports:
httr,
jsonlite,
stats,
utils
Suggests:
knitr,
Expand Down
1 change: 0 additions & 1 deletion NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,5 +8,4 @@ importFrom(httr,GET)
importFrom(httr,content)
importFrom(httr,stop_for_status)
importFrom(jsonlite,fromJSON)
importFrom(stats,na.omit)
importFrom(utils,data)
22 changes: 22 additions & 0 deletions R/detect_versions.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,22 @@
# WARNING - Generated by {fusen} from dev/cran_archive.Rmd: do not edit by hand

#' @noRd
detect_versions <- function(r_pkgs){
if(any(grepl("@", r_pkgs))){

cran_packages <- Filter(\(x)(!grepl("@", x)), r_pkgs)
archive_packages <- Filter(\(x)(grepl("@", x)), r_pkgs)

output <- list(
"cran_packages" = cran_packages,
"archive_packages" = archive_packages
)

} else {
output <- list(
"cran_packages" = r_pkgs,
"archive_packages" = NULL
)
}

}
84 changes: 9 additions & 75 deletions R/find_rev.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -73,78 +73,26 @@ get_current <- function() {
})
}

#' get_imports Get a package's dependencies
#' @param repo_url A character. The URL to the package's Github repository
#' @param commit. The commit hash of interest, for reproducibility's sake
#' @return A character. The packages listed under DESCRIPTION
#'
#' @noRd

get_imports <- function(repo_url, commit){

add_trailing_slash <- function(repo_url) {
if (substr(repo_url, nchar(repo_url), nchar(repo_url)) != "/") {
repo_url <- paste0(repo_url, "/")
}
repo_url
}

# remove string like ( >= 1.0.0) from listed packages
remove_parentheses <- function(input_list) {
output_list <- gsub("\\s*\\(.*?\\)", "", input_list)
output_list
}

repo_url <- add_trailing_slash(repo_url)

repo_url <- paste0(
gsub("github.com", "raw.githubusercontent.com", repo_url),
commit,
"/DESCRIPTION"
)

contents <- readLines(repo_url)

contents <- remove_parentheses(contents)

imports_line <- grep("^Imports:", contents)


input_string <- paste(trimws(contents[(imports_line+1):length(contents)]),
collapse = " ")

output <- regmatches(input_string,
regexpr(".*?(?<!,)\\s", input_string, perl = TRUE))

# put the output in vector format to allow removing of base packages
output <- gsub(",", "\n", output) |>
textConnection() |>
readLines() |>
trimws()

remove_base(output)
}


#' get_sri_hish Get the SRI hash of the NAR serialization of a Github repo
#' @param repo_url A character. The URL to the package's Github repository
#' @param branch_name A character. The branch of interest
#' @param commit A character. The commit hash of interest, for reproducibility's sake
#' @return The SRI hash as a character
#' @noRd
get_sri_hash <- function(repo_url, branch_name, commit){
get_sri_hash_deps <- function(repo_url, branch_name, commit){
result <- httr::GET(paste0("http://git2nixsha.dev:1506/hash?repo_url=",
repo_url,
"&branchName=",
branch_name,
"&commit=",
commit))

unlist(httr::content(result))
lapply(httr::content(result), unlist)

}

#' fetchgit Downloads and installs a package hosted of Git
#' @param git_pkg A list of at least four elements: "package_name", the name of the package, "repo_url", the repository's url, "branch_name", the name of the branch containing the code to download and "commit", the commit hash of interest. A fifth, optional argument called "sri_hash" can be provided, if available. If not, "sri_hash" will be obtained using `get_sri_hash()`
#' @param git_pkg A list of at least four elements: "package_name", the name of the package, "repo_url", the repository's url, "branch_name", the name of the branch containing the code to download and "commit", the commit hash of interest. A fifth, optional argument called "sri_hash" can be provided, if available. If not, "sri_hash" will be obtained using `get_sri_hash_deps()`
#' @return A character. The Nix definition to download and build the R package from Github.
#' @noRd
fetchgit <- function(git_pkg){
Expand All @@ -155,12 +103,13 @@ fetchgit <- function(git_pkg){
commit <- git_pkg$commit
sri_hash <- git_pkg$sri_hash

imports <- get_imports(repo_url, commit)

if(is.null(sri_hash)){
sri_hash <- get_sri_hash(repo_url, branch_name, commit)
output <- get_sri_hash_deps(repo_url, branch_name, commit)
sri_hash <- output$sri_hash
imports <- output$deps
} else {
sri_hash <- sri_hash
imports <- NULL
}

sprintf('(buildRPackage {
Expand All @@ -187,7 +136,7 @@ fetchgit <- function(git_pkg){


#' fetchgits Downloads and installs a packages hosted of Git. Wrapper around `fetchgit()` to handle multiple packages
#' @param git_pkg A list of at least four elements: "package_name", the name of the package, "repo_url", the repository's url, "branch_name", the name of the branch containing the code to download and "commit", the commit hash of interest. A fifth, optional argument called "sri_hash" can be provided, if available. If not, "sri_hash" will be obtained using `get_sri_hash()`. This argument can also be a list of lists of these four elements.
#' @param git_pkg A list of at least four elements: "package_name", the name of the package, "repo_url", the repository's url, "branch_name", the name of the branch containing the code to download and "commit", the commit hash of interest. A fifth, optional argument called "sri_hash" can be provided, if available. If not, "sri_hash" will be obtained using `get_sri_hash_deps()`. This argument can also be a list of lists of these four elements.
#' @return A character. The Nix definition to download and build the R package from Github.
#' @noRd
fetchgits <- function(git_pkgs){
Expand All @@ -202,21 +151,6 @@ fetchgits <- function(git_pkgs){

}

#' remove_base Remove base packages from `propagatedBuildInputs`
#' @param list_imports A list. A vector of R package names.
#' @return A list. A vector of R package names without base R packages.
#' @importFrom stats na.omit
#' @noRd
remove_base <- function(list_imports){

gsub("(base)|(compiler)|(datasets)|(grDevices)|(graphics)|(grid)|(methods)|(parallel)|(profile)|(splines)|(stats)|(stats4)|(tcltk)|(tools)|(translations)|(utils)",
NA_character_,
list_imports) |>
na.omit() |>
paste(collapse = " ")

}

#' rix Build a reproducible development environment definition
#' @return Nothing, this function only has the side-effect of writing a file
#' called "default.nix" in the working directory. This file contains the
Expand Down
7 changes: 7 additions & 0 deletions dev/0-dev_history.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -121,6 +121,13 @@ fusen::inflate(flat_file = "dev/interactive_use.Rmd",
overwrite = TRUE)
```

```{r}
fusen::inflate(flat_file = "dev/cran_archive.Rmd",
vignette_name = "Installing old packages from the CRAN archives",
overwrite = TRUE)
```



# Package development tools
## Use once
Expand Down
134 changes: 17 additions & 117 deletions dev/build_envs.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -113,110 +113,41 @@ get_current <- function() {
}
```

This function formats a `DESCRIPTION`'s file `imports` to return them
for the `propagatedBuildInputs` of a Nix `buildRPackage()` statement:

```{r function-get_imports}
#' get_imports Get a package's dependencies
#' @param repo_url A character. The URL to the package's Github repository
#' @param commit. The commit hash of interest, for reproducibility's sake
#' @return A character. The packages listed under DESCRIPTION
#'
#' @examples
get_imports <- function(repo_url, commit){
add_trailing_slash <- function(repo_url) {
if (substr(repo_url, nchar(repo_url), nchar(repo_url)) != "/") {
repo_url <- paste0(repo_url, "/")
}
repo_url
}
# remove string like ( >= 1.0.0) from listed packages
remove_parentheses <- function(input_list) {
output_list <- gsub("\\s*\\(.*?\\)", "", input_list)
output_list
}
repo_url <- add_trailing_slash(repo_url)
repo_url <- paste0(
gsub("github.com", "raw.githubusercontent.com", repo_url),
commit,
"/DESCRIPTION"
)
contents <- readLines(repo_url)
contents <- remove_parentheses(contents)
imports_line <- grep("^Imports:", contents)
input_string <- paste(trimws(contents[(imports_line+1):length(contents)]),
collapse = " ")
output <- regmatches(input_string,
regexpr(".*?(?<!,)\\s", input_string, perl = TRUE))
# put the output in vector format to allow removing of base packages
output <- gsub(",", "\n", output) |>
textConnection() |>
readLines() |>
trimws()
remove_base(output)
}
```

```{r tests-get_imports}
testthat::expect_equal(
get_imports("https://github.com/tidyverse/dplyr",
"1832ffbbdf3a85145b1545b84ee7b55a99fbae98"),
"cli generics glue lifecycle magrittr pillar R6 rlang tibble tidyselect vctrs"
)
testthat::expect_equal(
get_imports("https://github.com/rap4all/housing/",
"1c860959310b80e67c41f7bbdc3e84cef00df18e"),
"dplyr ggplot2 janitor purrr readxl rlang rvest stringr tidyr"
)
```

`get_sri_hash()` returns the SRI hash of a NAR serialized path to a cloned
`get_sri_hash_deps()` returns the SRI hash of a NAR serialized path to a cloned
Github repository. These hashes are used by Nix for security purposes. In
order to get the hash, a GET to a service I've made gets made. This request
gets handled by a server with Nix installed, and so the SRI hash can get computed`
by `nix hash path --sri path_to_repo`.

```{r function-get_sri_hash}
```{r function-get_sri_hash_deps}
#' get_sri_hish Get the SRI hash of the NAR serialization of a Github repo
#' @param repo_url A character. The URL to the package's Github repository
#' @param branch_name A character. The branch of interest
#' @param commit A character. The commit hash of interest, for reproducibility's sake
#' @return The SRI hash as a character
get_sri_hash <- function(repo_url, branch_name, commit){
get_sri_hash_deps <- function(repo_url, branch_name, commit){
result <- httr::GET(paste0("http://git2nixsha.dev:1506/hash?repo_url=",
repo_url,
"&branchName=",
branch_name,
"&commit=",
commit))
unlist(httr::content(result))
lapply(httr::content(result), unlist)
}
```

```{r tests-get_sri_hash}
```{r tests-get_sri_hash_deps}
testthat::expect_equal(
get_sri_hash("https://github.com/rap4all/housing/",
get_sri_hash_deps("https://github.com/rap4all/housing/",
"fusen",
"1c860959310b80e67c41f7bbdc3e84cef00df18e"),
"sha256-s4KGtfKQ7hL0sfDhGb4BpBpspfefBN6hf+XlslqyEn4="
list(
"sri_hash" = "sha256-s4KGtfKQ7hL0sfDhGb4BpBpspfefBN6hf+XlslqyEn4=",
"deps" = "dplyr ggplot2 janitor purrr readxl rlang rvest stringr tidyr"
)
)
```
Expand All @@ -228,7 +159,7 @@ automatically finds the right `sha256` as well:

```{r function-fetchgit}
#' fetchgit Downloads and installs a package hosted of Git
#' @param git_pkg A list of at least four elements: "package_name", the name of the package, "repo_url", the repository's url, "branch_name", the name of the branch containing the code to download and "commit", the commit hash of interest. A fifth, optional argument called "sri_hash" can be provided, if available. If not, "sri_hash" will be obtained using `get_sri_hash()`
#' @param git_pkg A list of at least four elements: "package_name", the name of the package, "repo_url", the repository's url, "branch_name", the name of the branch containing the code to download and "commit", the commit hash of interest. A fifth, optional argument called "sri_hash" can be provided, if available. If not, "sri_hash" will be obtained using `get_sri_hash_deps()`
#' @return A character. The Nix definition to download and build the R package from Github.
fetchgit <- function(git_pkg){
Expand All @@ -238,12 +169,13 @@ fetchgit <- function(git_pkg){
commit <- git_pkg$commit
sri_hash <- git_pkg$sri_hash
imports <- get_imports(repo_url, commit)
if(is.null(sri_hash)){
sri_hash <- get_sri_hash(repo_url, branch_name, commit)
output <- get_sri_hash_deps(repo_url, branch_name, commit)
sri_hash <- output$sri_hash
imports <- output$deps
} else {
sri_hash <- sri_hash
imports <- NULL
}
sprintf('(buildRPackage {
Expand Down Expand Up @@ -275,7 +207,7 @@ packages:

```{r function-fetchgits}
#' fetchgits Downloads and installs a packages hosted of Git. Wrapper around `fetchgit()` to handle multiple packages
#' @param git_pkg A list of at least four elements: "package_name", the name of the package, "repo_url", the repository's url, "branch_name", the name of the branch containing the code to download and "commit", the commit hash of interest. A fifth, optional argument called "sri_hash" can be provided, if available. If not, "sri_hash" will be obtained using `get_sri_hash()`. This argument can also be a list of lists of these four elements.
#' @param git_pkg A list of at least four elements: "package_name", the name of the package, "repo_url", the repository's url, "branch_name", the name of the branch containing the code to download and "commit", the commit hash of interest. A fifth, optional argument called "sri_hash" can be provided, if available. If not, "sri_hash" will be obtained using `get_sri_hash_deps()`. This argument can also be a list of lists of these four elements.
#' @return A character. The Nix definition to download and build the R package from Github.
fetchgits <- function(git_pkgs){
Expand All @@ -290,38 +222,6 @@ fetchgits <- function(git_pkgs){
}
```

Base packages are not available in `nixpkgs` and are installed with R
automatically. So if a package lists a base package in its `IMPORTS`, this base
package needs to be removed, or else there will be an error message when trying
to build a package from Github that will list its `IMPORTS` under
`propagatedBuildInputs`. The function below removes base packages:

```{r function-remove_base}
#' remove_base Remove base packages from `propagatedBuildInputs`
#' @param list_imports A list. A vector of R package names.
#' @return A list. A vector of R package names without base R packages.
#' @importFrom stats na.omit
remove_base <- function(list_imports){
gsub("(base)|(compiler)|(datasets)|(grDevices)|(graphics)|(grid)|(methods)|(parallel)|(profile)|(splines)|(stats)|(stats4)|(tcltk)|(tools)|(translations)|(utils)",
NA_character_,
list_imports) |>
na.omit() |>
paste(collapse = " ")
}
```

```{r tests-remove_base}
testthat::expect_equal(
remove_base(
c("base","compiler","datasets","grDevices","graphics","grid","methods","parallel","profile","splines","stats","stats4","tcltk","tools","translations","utils", "dplyr", "fusen")
),
"dplyr fusen"
)
```



This next function returns a `default.nix` file that can be used to build a
Expand Down
13 changes: 13 additions & 0 deletions dev/config_fusen.yaml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,19 @@ building_envs_with_rix.Rmd:
check: true
document: true
overwrite: 'yes'
cran_archive.Rmd:
path: dev/cran_archive.Rmd
state: active
R: R/detect_versions.R
tests: tests/testthat/test-detect_versions.R
vignettes: vignettes/installing-old-packages-from-the-cran-archives.Rmd
inflate:
flat_file: dev/cran_archive.Rmd
vignette_name: Installing old packages from the CRAN archives
open_vignette: true
check: true
document: true
overwrite: 'yes'
data_doc.Rmd:
path: dev/data_doc.Rmd
state: active
Expand Down
Loading

0 comments on commit eeeb1b8

Please sign in to comment.