From 91e9553da5f8976dacb718e290af1c510d470155 Mon Sep 17 00:00:00 2001
From: Kevin Ushey <kevinushey@gmail.com>
Date: Mon, 5 Aug 2024 21:47:36 -0700
Subject: [PATCH] keep RemoteSha if it appears to be a hash

---
 R/snapshot.R                   | 38 +++++++++++++++++++++----------
 tests/testthat/test-snapshot.R | 41 ++++++++++++++++++++++++++++++++++
 2 files changed, 67 insertions(+), 12 deletions(-)

diff --git a/R/snapshot.R b/R/snapshot.R
index d517a4ce4..2192d081b 100644
--- a/R/snapshot.R
+++ b/R/snapshot.R
@@ -756,21 +756,11 @@ renv_snapshot_description_impl <- function(dcf, path = NULL) {
   dcf[["Requirements"]] <- all
 
   # get remotes fields
-  git <- grep("^git", names(dcf), value = TRUE)
-  remotes <- grep("^Remote", names(dcf), value = TRUE)
-
-  # don't include 'RemoteRef' if it's a non-informative remote
-  if (identical(dcf[["RemoteRef"]], "HEAD"))
-    remotes <- setdiff(remotes, "RemoteRef")
-
-  # drop remote metadata for 'standard' remotes, to avoid spurious
-  # diffs that could arise from installing a package using 'pak'
-  # versus 'install.packages()' or an alternate tool
-  std <- identical(dcf[["RemoteType"]], "standard")
+  remotes <- renv_snapshot_description_impl_remotes(dcf)
 
   # only keep relevant fields
   extra <- c("Repository", "OS_type")
-  all <- c(required, extra, if (!std) c(remotes, git), "Requirements", "Hash")
+  all <- c(required, extra, remotes, "Requirements", "Hash")
   keep <- renv_vector_intersect(all, names(dcf))
 
   # return as list
@@ -778,6 +768,30 @@ renv_snapshot_description_impl <- function(dcf, path = NULL) {
 
 }
 
+renv_snapshot_description_impl_remotes <- function(dcf) {
+
+  # if this seems to be a cran-like record, only keep remotes
+  # when RemoteSha appears to be a hash (e.g. for r-universe)
+  # note that RemoteSha may be a package version when installed
+  # by e.g. pak
+  if (renv_record_cranlike(dcf)) {
+    sha <- dcf[["RemoteSha"]]
+    if (is.null(sha) || nchar(sha) < 40)
+      return(character())
+  }
+
+  # grab the relevant remotes
+  git <- grep("^git", names(dcf), value = TRUE)
+  remotes <- grep("^Remote(?!s)", names(dcf), perl = TRUE, value = TRUE)
+
+  # don't include 'RemoteRef' if it's a non-informative remote
+  if (identical(dcf[["RemoteRef"]], "HEAD"))
+    remotes <- setdiff(remotes, "RemoteRef")
+
+  c(git, remotes)
+
+}
+
 renv_snapshot_description_source_custom <- function(dcf) {
 
   # only proceed for cranlike remotes
diff --git a/tests/testthat/test-snapshot.R b/tests/testthat/test-snapshot.R
index 5c09188b4..96299da15 100644
--- a/tests/testthat/test-snapshot.R
+++ b/tests/testthat/test-snapshot.R
@@ -573,3 +573,44 @@ test_that("packages installed from r-universe preserve remote metadata", {
   expect_identical(record[["RemoteSha"]], "e4aafb92b86ba7eba3b7036d9d96fdfb6c32761a")
 
 })
+
+test_that("standard remotes preserve RemoteSha if it's a hash", {
+
+  text <- heredoc("
+    Package: skeleton
+    Type: Package
+    Version: 1.1.0
+    Remotes: kevinushey/skeleton
+    Repository: https://kevinushey.r-universe.dev
+    RemoteType: standard
+    RemoteUrl: https://github.com/kevinushey/skeleton
+    RemoteSha: e4aafb92b86ba7eba3b7036d9d96fdfb6c32761a
+  ")
+
+  path <- renv_scope_tempfile()
+  writeLines(text, con = path)
+
+  record <- renv_snapshot_description(path = path)
+  expect_identical(record[["RemoteSha"]], "e4aafb92b86ba7eba3b7036d9d96fdfb6c32761a")
+
+})
+
+test_that("standard remotes drop RemoteSha if it's a version", {
+
+  text <- heredoc("
+    Package: skeleton
+    Type: Package
+    Version: 1.1.0
+    Remotes: kevinushey/skeleton
+    Repository: https://kevinushey.r-universe.dev
+    RemoteType: standard
+    RemoteSha: 1.1.0
+  ")
+
+  path <- renv_scope_tempfile()
+  writeLines(text, con = path)
+
+  record <- renv_snapshot_description(path = path)
+  expect_null(record[["RemoteSha"]])
+
+})