r-lib · gaborcsardi · Sep 20, 2023 · Jun 6, 2023 · Sep 18, 2023 · Sep 18, 2023
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -51,18 +51,14 @@ Suggests:
     rmarkdown,
     rstudioapi,
     spelling,
+    svglite,
     testthat,
     tibble,
     webfakes (>= 1.1.5.9000),
     withr (>= 2.1.1),
 Config/Needs/coverage:
     r-lib/asciicast,
-    covr,
-    rmarkdown,
-    svglite
-Config/Needs/dev:
-    rmarkdown,
-    svglite
+    covr
 Config/Needs/website:
     r-lib/asciicast,
     pkgdown (>= 2.0.2),

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,8 @@
 # pkgdepends (development version)
 
+* pkgdepends now correctly supports the `@*release` suffix for GitHub
+  repositories (#275, @pawelru).
+
 # pkgdepends 0.6.0
 
 * Many system requirements improvements:
@@ -30,6 +33,8 @@
 
 * pkgdepends now correctly parses multiple `git::` packages at once (#318).
 
+* Fix `@*release` reference for the latest release.
+
 * `git::` package sources now support version 1 of the git protocol.
   E.g. the Bioconductor git repositories now work:
   `git::https://git.bioconductor.org/packages/limma` (#314).

diff --git a/R/gh-app.R b/R/gh-app.R
@@ -273,6 +273,38 @@ gh_app <- function(repos = NULL, log = interactive(), options = list()) {
     send_sha_not_found(res, psd)
   })
 
+  app$post("/graphql", function(req, res) {
+    re_release <- paste0(
+      "owner:[ ]*\"(?<user>[^\"]+)\"", "(?s:.)*",
+      "name:[ ]*\"(?<repo>[^\"]+)\"", "(?s:.)*",
+      "file[(]path:[ ]*\"(?<path>.*)\""
+    )
+
+    psd <- re_match(req$json$query, re_release)
+    if (is.na(psd$.match)) return("next")
+
+    commits <- app$locals$repos$users[[psd$user]]$repos[[psd$repo]]$commits
+    for (cmt in commits) {
+      if (isTRUE(cmt$latestRelease)) {
+        add_gh_headers(res)
+        dsc <- cmt$files[[psd$path]]
+        res$send_json(
+          auto_unbox = TRUE,
+          list(data = list(repository = list(latestRelease = list(
+            tagName = cmt$tagName,
+            tagCommit = list(
+              oid = cmt$sha,
+              file = list(object = gh_fmt_desc(dsc))
+            )
+          ))))
+        )
+        return()
+      }
+    }
+
+    send_no_releases(res, psd)
+  })
+
   app$get("/repos/:user/:repo/zipball/:sha", function(req, res) {
     if (!req$params$user %in% names(app$locals$repos$users)) {
       send_user_not_found(res, req$params)
@@ -368,4 +400,13 @@ send_sha_not_found <- function(res, psd) {
   res$send_status(404)
 }
 
+send_no_releases <- function(res, psd) {
+  res$set_status(200)
+  res$send_json(auto_unbox = TRUE,
+    list(
+      data = list(repository = list(latestRelease = NA))
+    )
+  )
+}
+
 # nocov end
diff --git a/R/type-github.R b/R/type-github.R
@@ -228,6 +228,8 @@ type_github_get_headers <- function() {
 type_github_get_data <- function(rem) {
   dx <- if (!is.null(rem$pull) && rem$pull != "") {
     type_github_get_data_pull(rem)
+  } else if (!is.null(rem$release) && rem$release != "") {
+    type_github_get_data_release(rem)
   } else {
     type_github_get_data_ref(rem)
   }
@@ -358,6 +360,60 @@ check_github_response_pull2 <- function(resp, obj, rem, call.) {
   obj
 }
 
+type_github_get_data_release <- function(rem) {
+  call <- sys.call(-1)
+  user <- rem$username
+  repo <- rem$repo
+  ref <- NULL
+  subdir <- rem$subdir %&z&% paste0(utils::URLencode(rem$subdir), "/")
+
+  query <- glue("{
+    repository(owner: \"<user>\", name:\"<repo>\") {
+      latestRelease {
+        tagName
+        tagCommit {
+          oid,
+          file(path: \"<subdir>DESCRIPTION\") {
+            object {
+              ... on Blob {
+                isBinary
+                text
+              }
+            }
+          }
+        }
+      }
+    }
+  }",
+  .open = "<", .close = ">")
+
+  github_query(query)$
+    then(function(resp) {
+      check_github_response_release(resp$response, resp$obj, rem, call. = call)
+    })$
+    then(function(obj) {
+      ref <- obj[[c("data", "repository", "latestRelease", "tagCommit", "oid")]]
+      txt <- obj[[c("data", "repository", "latestRelease", "tagCommit", "file", "object", "text")]]
+      list(sha = ref, desc = txt)
+    })
+}
+
+check_github_response_release <- function(resp, obj, rem, call.) {
+  if (!is.null(obj$errors)) {
+    throw(new_github_query_error(rem, resp, obj, call.))
+  }
+  if (is.null(obj[[c("data", "repository", "latestRelease")]])) {
+    throw(new_github_no_release_error(rem, call.))
+  }
+  if (isTRUE(obj[[c("data", "repository", "latestRelease", "tagCommit", "file", "object", "isBinary")]])) {
+    throw(new_github_baddesc_error(rem, call.))
+  }
+  if (is.null(obj[[c("data", "repository", "latestRelease", "tagCommit", "file", "object")]])) {
+    throw(new_github_no_package_error(rem, call.))
+  }
+  obj
+}
+
 type_github_make_resolution <- function(data) {
 
   deps <- resolve_ref_deps(
@@ -555,6 +611,12 @@ new_github_nopr_error <- function(rem, obj, call. = NULL) {
   new_github_error(msg, call. = call.)
 }
 
+# No releases
+new_github_no_release_error <- function(rem, obj, call. = NULL) {
+  msg <- glue("Can't find any release in GitHub repo {rem$username}/{rem$repo}.")
+  new_github_error(msg, call. = call.)
+}
+
 # No such branch/tag/ref
 
 new_github_noref_error <- function(rem, call. = NULL) {

diff --git a/tests/testthat/_snaps/github-tools.md b/tests/testthat/_snaps/github-tools.md
@@ -37,6 +37,19 @@
       Version: 1.0.0
 
 
+---
+
+    Code
+      synchronise(type_github_get_data(parse_pkg_ref("r-lib/pak@*release")))
+    Output
+      $sha
+      [1] "b001d6ddeab1589ad367b62baabbeeb2af3b0ebac2e61d239df660c1d63e3232"
+
+      $description
+      Package: pak
+      Version: 1.0.0
+
+
 ---
 
     Code
@@ -220,6 +233,13 @@
     Error <async_rejected>
       ! Can't find reference @bad-ref-no-no-no in GitHub repo r-lib/pak.
 
+# no release error
+
+    Code
+      synchronise(type_github_get_data(parse_pkg_ref("r-lib/bad@*release")))
+    Error <async_rejected>
+      ! Can't find any release in GitHub repo r-lib/bad.
+
 # builtin token messages once per session
 
     Code

diff --git a/tests/testthat/helper-apps.R b/tests/testthat/helper-apps.R
@@ -176,6 +176,12 @@ gh_app_repos <- list(
               branch = "somebranch",
               pull = 90,
               files = list("DESCRIPTION" = gh_app_desc("pak"), NAMESPACE = "")
+            ),
+            list(
+              sha = "b001d6ddeab1589ad367b62baabbeeb2af3b0ebac2e61d239df660c1d63e3232",
+              latestRelease = TRUE,
+              tagName = "v1.2.3",
+              files = list("DESCRIPTION" = gh_app_desc("pak"), NAMESPACE = "")
             )
           )
         ),

diff --git a/tests/testthat/test-github-tools.R b/tests/testthat/test-github-tools.R
@@ -11,6 +11,9 @@ test_that("type_github_get_data, sha, description", {
   expect_snapshot(
     synchronise(type_github_get_data(parse_pkg_ref("r-lib/pak@v0.1.2")))
   )
+  expect_snapshot(
+    synchronise(type_github_get_data(parse_pkg_ref("r-lib/pak@*release")))
+  )
   expect_snapshot(
     synchronise(type_github_get_data(parse_pkg_ref(
       "r-lib/pak@e65de1e9630d"
@@ -175,6 +178,15 @@ test_that("no such ref error", {
   )
 })
 
+test_that("no release error", {
+  setup_fake_gh_app()
+  expect_snapshot(
+    error = TRUE,
+    synchronise(type_github_get_data(parse_pkg_ref("r-lib/bad@*release"))),
+    transform = transform_no_srcref
+  )
+})
+
 test_that("builtin token messages once per session", {
   once_per_session(reset = TRUE)
   mockery::stub(type_github_builtin_token, "sample", "builtin-token")