Support git_submodules for github:: remotes

NEWS.md

@@ -1,5 +1,10 @@
 # pkgdepends (development version)
 
+* `github::` remotes now support Git submodules, if the `git_submodules`
+  configuration option is set. Previously this option only had an effect for
+  `git::` and `gitlab::` remotes, so submodules were silently missing from
+  packages installed from GitHub (#480).
+
 * Blank lines in `.Rbuildignore` no longer cause all git submodules of a
   package to be skipped, empty lines are now dropped (#480).
 

R/type-git.R

@@ -104,7 +104,12 @@ download_remote_git <- function(
 
   rel_target <- resolution$target
   subdir <- resolution$remote[[1]]$subdir
-  if (!nocache) {
+  submodules <- config$get("git-submodules")
+  ## We never put a snapshot with submodules into the cache, and a cached
+  ## snapshot may well be missing them, e.g. the repo snapshots we download
+  ## from the GitHub API never have them. So we ignore the cache here if
+  ## submodules are needed.
+  if (!nocache && !submodules) {
     hit <- cache$package$copy_to(
       target_tree,
       package = package,
@@ -125,7 +130,6 @@ download_remote_git <- function(
   p <- async_git_download_repo(url, ref = sha, output = pkgdir)
 
   # submodules?
-  submodules <- config$get("git-submodules")
   if (submodules) {
     p <- p$then(function(x) async_update_git_submodules_r(pkgdir, subdir))
   }

R/type-github.R

@@ -68,6 +68,27 @@ download_remote_github <- function(
   ## 4. Otherwise we download the repo, add it to the cache, build the
   ##    R package, and add that to the cache as well.
 
+  ## The repo snapshot we download from the GitHub API never contains the
+  ## contents of the Git submodules of the repository. So if we need those,
+  ## we download the repository over the Git protocol instead, exactly like
+  ## for `git::` and `gitlab::` remotes.
+  ## https://github.com/r-lib/pkgdepends/issues/480
+  if (config$get("git-submodules")) {
+    resolution$remote[[1]]$url <- github_git_url(
+      resolution$remote[[1]]$username,
+      resolution$remote[[1]]$repo
+    )
+    return(download_remote_git(
+      resolution,
+      target,
+      target_tree,
+      config,
+      cache,
+      which,
+      on_progress
+    ))
+  }
+
   package <- resolution$package
   sha <- resolution$extra[[1]][["remotesha"]] %||% NA_character_
   need_vignettes <- which == "resolution"
@@ -244,6 +265,19 @@ installedok_remote_github <- function(installed, solution, config, ...) {
 ## ----------------------------------------------------------------------
 ## Internal functions
 
+# The URL of the Git repository behind a GitHub remote. GitHub serves its
+# API on a different host (or path) than the Git repositories themselves,
+# so we derive one from the other:
+# * `https://api.github.com` -> `https://github.com`,
+# * `https://ghe.example.com/api/v3` -> `https://ghe.example.com`.
+github_git_url <- function(username, repo) {
+  url <- Sys.getenv("R_PKG_GITHUB_API_URL", "https://api.github.com")
+  url <- sub("/+$", "", url)
+  url <- sub("/api(/v[0-9]+)?$", "", url)
+  url <- sub("^([a-zA-Z0-9]+://)api[.]", "\\1", url)
+  paste0(url, "/", username, "/", repo, ".git")
+}
+
 # Well-known subdirectories to probe for a DESCRIPTION when no `subdir` is
 # given. Order matters: the first match wins, and "" (the repo root) always
 # takes precedence, so repos with a root DESCRIPTION are unaffected.

tests/testthat/test-type-github.R

@@ -245,6 +245,84 @@ test_that("download_remote", {
   expect_false(file.exists(dl$fulltarget_tree))
 })
 
+test_that("github_git_url", {
+  withr::local_envvar(R_PKG_GITHUB_API_URL = NA)
+  expect_equal(
+    github_git_url("r-lib", "pak"),
+    "https://github.com/r-lib/pak.git"
+  )
+
+  # GitHub Enterprise
+  withr::local_envvar(R_PKG_GITHUB_API_URL = "https://ghe.example.com/api/v3")
+  expect_equal(
+    github_git_url("r-lib", "pak"),
+    "https://ghe.example.com/r-lib/pak.git"
+  )
+
+  # Anything else is used as is, sans trailing slashes
+  withr::local_envvar(R_PKG_GITHUB_API_URL = "http://127.0.0.1:3000/")
+  expect_equal(
+    github_git_url("user", "repo"),
+    "http://127.0.0.1:3000/user/repo.git"
+  )
+})
+
+test_that("download_remote with submodules uses git", {
+  # The snapshots we download from the GitHub API do not include the
+  # submodules, so we need to fall back to a git download.
+  # https://github.com/r-lib/pkgdepends/issues/480
+  skip_on_cran()
+  if (Sys.which("git") == "") {
+    skip("Needs git")
+  }
+
+  # `fake_gitlab` serves the git fixture from the *parent* of the `repo`
+  # directory, so a GitHub style `<username>/<repo>.git` path, i.e.
+  # `/repo/pak-test.git` here, resolves to the `pak-test` fixture repo.
+  withr::local_envvar(R_PKG_GITHUB_API_URL = fake_gitlab$url())
+  local_fake_git_no_creds(fake_gitlab$url())
+
+  dir.create(tmp <- tempfile())
+  dir.create(tmp2 <- tempfile())
+  on.exit(unlink(c(tmp, tmp2), recursive = TRUE), add = TRUE)
+
+  conf <- current_config()
+  conf$set("cache-dir", tmp)
+  conf$set("package-cache-dir", tmp2)
+  conf$set("git-submodules", TRUE)
+  cache <- list(package = pkgcache::package_cache$new(tmp2))
+
+  # The `build-ignore` branch of the fixture has a `cli` submodule, which
+  # is listed in `.Rbuildignore`, so it must not be downloaded.
+  sha <- "a9ffc55f59e0567ecdc67fb3f0333eca49be8d03"
+  res <- make_fake_resolution(
+    `github::repo/pak-test` = list(
+      package = "empty",
+      extra = list(list(remotesha = sha)),
+      metadata = list(list(RemoteSha = sha))
+    )
+  )
+
+  target <- file.path(tmp, res$target[1])
+  tree <- paste0(target, "-t")
+  dl <- synchronise(download_remote_github(
+    res[1, ],
+    target,
+    tree,
+    conf,
+    cache,
+    which = "resolution",
+    on_progress = NULL
+  ))
+
+  expect_equal(dl, "Got")
+  # A git download creates a directory, the GitHub API snapshot is a file
+  expect_false(file.exists(target))
+  expect_true(dir.exists(file.path(tree, "empty")))
+  expect_true(file.exists(file.path(tree, "empty", "DESCRIPTION")))
+  expect_false(file.exists(file.path(tree, "empty", "cli")))
+})
+
 test_that("satisfies_remote", {
   res <- make_fake_resolution(
     `github::r-lib/crayon` = list(