Do not write error bodies to .destfile

Now gh always writes the output to a temporary file, which is
then renamed to `.destfile`, or deleted on error.

Closes #178.

DESCRIPTION

@@ -38,4 +38,4 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1.9000

NEWS.md

@@ -3,6 +3,10 @@
 * `gh_next()`, `gh_prev()`, `gh_first()` and `gh_last()`
   now work correctly again (#181).
 
+* When the user sets `.destfile` to write the response to disk, gh now
+  writes the output to a temporary file, which is then renamed to
+  `.destfile` after performing the request, or deleted on error (#178).
+
 # gh 1.4.0
 
 * `gh()` gains a new `.max_rate` parameter that sets the maximum number of

R/gh.R

@@ -31,9 +31,15 @@
 #'   otherwise determined by the API (never greater than 100).
 #' @param .destfile Path to write response to disk. If `NULL` (default),
 #'   response will be processed and returned as an object. If path is given,
-#'   response will be written to disk in the form sent.
+#'   response will be written to disk in the form sent. gh writes the
+#'   response to a temporary file, and renames that file to `.destfile`
+#'   after the request was successful. The name of the temporary file is
+#'   created by adding a `-<random>.gh-tmp` suffix to it, where `<random>`
+#'   is an ASCII string with random characters. gh removes the temporary
+#'   file on error.
 #' @param .overwrite If `.destfile` is provided, whether to overwrite an
-#'   existing file.  Defaults to `FALSE`.
+#'   existing file.  Defaults to `FALSE`. If an error happens the original
+#'   file is kept.
 #' @param .token Authentication token. Defaults to `GITHUB_PAT` or
 #'   `GITHUB_TOKEN` environment variables, in this order if any is set.
 #'   See [gh_token()] if you need more flexibility, e.g. different tokens
@@ -299,19 +305,20 @@ gh_make_request <- function(x, error_call = caller_env()) {
   # allow custom handling with gh_error
   req <- httr2::req_error(req, is_error = function(resp) FALSE)
 
-  resp <- httr2::req_perform(req, path = x$dest)
+  resp <- httr2::req_perform(req, path = x$desttmp)
   if (httr2::resp_status(resp) >= 300) {
-    gh_error(resp, error_call = error_call)
+    gh_error(resp, gh_req = x, error_call = error_call)
   }
 
   resp
 }
 
 # https://docs.github.com/v3/#client-errors
-gh_error <- function(response, error_call = caller_env()) {
+gh_error <- function(response, gh_req, error_call = caller_env()) {
   heads <- httr2::resp_headers(response)
   res <- httr2::resp_body_json(response)
   status <- httr2::resp_status(response)
+  if (!is.null(gh_req$desttmp)) unlink(gh_req$desttmp)
 
   msg <- "GitHub API error ({status}): {heads$status %||% ''} {res$message}"
 

R/gh_request.R

@@ -41,7 +41,8 @@ gh_build_request <- function(endpoint = "/user",
   working <- gh_set_body(working)
   working <- gh_set_url(working)
   working <- gh_set_headers(working)
-  working[c("method", "url", "headers", "query", "body", "dest", "max_wait", "max_rate")]
+  working <- gh_set_temp_destfile(working)
+  working[c("method", "url", "headers", "query", "body", "dest", "desttmp", "max_wait", "max_rate")]
 }
 
 
@@ -142,6 +143,15 @@ gh_set_url <- function(x) {
   x
 }
 
+gh_set_temp_destfile <- function(working) {
+  working$desttmp <- if (is.null(working$dest)) {
+    NULL
+  } else {
+    paste0(working$dest, "-", basename(tempfile("")), ".gh-tmp")
+  }
+  working
+}
+
 get_baseurl <- function(url) { # https://github.uni.edu/api/v3/
   if (!any(grepl("^https?://", url))) {
     stop("Only works with HTTP(S) protocols")

R/gh_response.R

@@ -11,6 +11,8 @@ gh_process_response <- function(resp, gh_req) {
 
   if (is_ondisk) {
     res <- as.character(resp$body)
+    file.rename(res, gh_req$dest)
+    res <- gh_req$dest
   } else if (is_empty) {
     res <- list()
   } else if (grepl("^application/json", content_type, ignore.case = TRUE)) {

tests/testthat/test-gh_response.R

@@ -69,3 +69,17 @@ test_that("captures details to recreate request", {
   expect_equal(attr(res, "method"), "GET")
   expect_type(attr(res, ".send_headers"), "list")
 })
+
+test_that("output file is not overwritten on error", {
+  tmp <- withr::local_tempfile()
+  writeLines("foo", tmp)
+
+  err <- tryCatch(
+    gh("/repos", .destfile = tmp),
+    error = function(e) e
+  )
+
+  expect_true(file.exists(tmp))
+  expect_equal(readLines(tmp), "foo")
+  expect_true(!is.null((err$response_content)))
+})