Use a single GH graphql for pull requests

r-lib · Sep 20, 2023 · c176fd9 · c176fd9
1 parent 6dbac81
commit c176fd9
Show file tree

Hide file tree

Showing 2 changed files with 35 additions and 73 deletions.
diff --git a/R/gh-app.R b/R/gh-app.R
@@ -201,13 +201,14 @@ gh_app <- function(repos = NULL, log = interactive(), options = list()) {
   })
 
   app$post("/graphql", function(req, res) {
-    re_pull_1 <- paste0(
+    re_pull <- paste0(
       "owner:[ ]*\"(?<user>[^\"]+)\"", "(?s:.)*",
       "name:[ ]*\"(?<repo>[^\"]+)\"", "(?s:.)*",
-      "number:[ ]*(?<pull>[0-9]+)[)]"
+      "pullRequest[(]number:[ ]*(?<pull>[0-9]+)[)]", "(?s:.)*",
+      "file[(]path:[ ]*\"(?<path>.*)\""
     )
 
-    psd <- re_match(req$json$query, re_pull_1)
+    psd <- re_match(req$json$query, re_pull)
     if (is.na(psd$.match)) return("next")
 
     if (!psd$user %in% names(app$locals$repos$users)) {
@@ -223,10 +224,12 @@ gh_app <- function(repos = NULL, log = interactive(), options = list()) {
     for (cmt in commits) {
       if (!is.null(cmt$pull) && cmt$pull == psd$pull) {
         add_gh_headers(res)
+        dsc <- cmt$files[[psd$path]]
         res$send_json(
           auto_unbox = TRUE,
           list(data = list(repository = list(pullRequest = list(
-            headRefOid = cmt$sha
+            headRefOid = cmt$sha,
+            headRef = list(target = list(file = list(object = gh_fmt_desc(dsc))))
           ))))
         )
         return()
@@ -236,43 +239,7 @@ gh_app <- function(repos = NULL, log = interactive(), options = list()) {
     send_pull_not_found(res, psd)
   })
 
-  app$post("/graphql", function(req, res) {
-    re_pull_2 <- paste0(
-      "owner:[ ]*\"(?<user>[^\"]+)\"", "(?s:.)*",
-      "name:[ ]*\"(?<repo>[^\"]+)\"", "(?s:.)*",
-      "object[(]expression:[ ]*\"(?<sha>[^:]+):(?<path>.*)\""
-    )
-
-    psd <- re_match(req$json$query, re_pull_2)
-    if (is.na(psd$.match)) return("next")
-
-    if (!psd$user %in% names(app$locals$repos$users)) {
-      send_user_not_found(res, psd)
-      return()
-    }
-    if (!psd$repo %in% names(app$locals$repos$users[[psd$user]]$repos)) {
-      send_repo_not_found(res, psd)
-      return()
-    }
-
-    commits <- app$locals$repos$users[[psd$user]]$repos[[psd$repo]]$commits
-    for (cmt in commits) {
-      if (cmt$sha == psd$sha) {
-        add_gh_headers(res)
-        dsc <- cmt$files[[psd$path]]
-        res$send_json(
-          auto_unbox = TRUE,
-          list(data = list(repository = list(
-            object = gh_fmt_desc(dsc)
-          )))
-        )
-        return()
-      }
-    }
-
-    send_sha_not_found(res, psd)
-  })
-
+  # @*release
   app$post("/graphql", function(req, res) {
     re_release <- paste0(
       "owner:[ ]*\"(?<user>[^\"]+)\"", "(?s:.)*",

diff --git a/R/type-github.R b/R/type-github.R
@@ -297,64 +297,59 @@ type_github_get_data_pull <- function(rem) {
   user <- rem$username
   repo <- rem$repo
   pull <- rem$pull
-  ref <- NULL
   subdir <- rem$subdir %&z&% paste0(utils::URLencode(rem$subdir), "/")
 
-  # Get the sha first, seemingly there is no good way to do this in one go
-  query1 <- glue("{
-    repository(owner: \"<user>\", name:\"<repo>\") {
+  query <- glue("{
+    repository(owner: \"<user>\", name: \"<repo>\") {
       pullRequest(number: <pull>) {
         headRefOid
+        headRef {
+          target {
+            ... on Commit {
+              file(path: \"<subdir>DESCRIPTION\") {
+                object {
+                  ... on Blob {
+                    isBinary
+                    text
+                  }
+                }
+              }
+            }
+          }
+        }
       }
     }
   }",
   .open = "<", .close = ">")
 
-  github_query(query1)$
-    then(function(resp) {
-      check_github_response_pull1(resp$response, resp$obj, rem, call. = call)
-    })$
-    then(function(obj) {
-      ref <<- obj[[c("data", "repository", "pullRequest", "headRefOid")]]
-      query2 <- glue("{
-        repository(owner: \"<user>\", name:\"<repo>\") {
-          object(expression: \"<ref>:<subdir>DESCRIPTION\") {
-            ... on Blob {
-              isBinary
-              text
-            }
-          }
-        }
-      }",
-      .open = "<", .close = ">")
-      github_query(query2)
-    })$
+  github_query(query)$
     then(function(resp) {
-      check_github_response_pull2(resp$response, resp$obj, rem, call. = call)
+      check_github_response_pull(resp$response, resp$obj, rem, call. = call)
     })$
     then(function(obj) {
-      txt <- obj[[c("data", "repository", "object", "text")]]
+      ref <- obj[[c("data", "repository", "pullRequest", "headRefOid")]]
+      txt <- obj[[c("data", "repository", "pullRequest", "headRef",
+                    "target", "file", "object", "text")]]
       list(sha = ref, desc = txt)
     })
 }
 
-check_github_response_pull1 <- function(resp, obj, rem, call.) {
+check_github_response_pull <- function(resp, obj, rem, call.) {
   if (!is.null(obj$errors)) {
     throw(new_github_query_error(rem, resp, obj, call.))
   }
-  obj
-}
-
-check_github_response_pull2 <- function(resp, obj, rem, call.) {
   # No full coverage here, because unless something goes super wrong,
   # these cases almost never happen.
   if (!is.null(obj$errors)) {
     throw(new_github_query_error(rem, resp, obj, call.))            # nocov
   }
-  if (isTRUE(obj[[c("data", "repository", "object", "isBinary")]])) {
+
+  if (isTRUE(obj[[c("data", "repository", "pullRequest", "headRef",
+                    "target", "file", "object", "isBinary")]])) {
     throw(new_github_baddesc_error(rem, call.))                     # nocov
   }
-  if (is.null(obj[[c("data", "repository", "object")]])) {
+  if (is.null(obj[[c("data", "repository", "pullRequest", "headRef",
+                     "target", "file", "object")]])) {
     throw(new_github_no_package_error(rem, call.))
   }
   obj