From 04ef802df66722ab34e6a66cef88bee2b2fd59c5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= <csardi.gabor@gmail.com>
Date: Tue, 24 Sep 2024 09:36:49 +0200
Subject: [PATCH] Use same http options as pak/pkgcache

In particular the path to the CA bundle, for
https://github.com/r-lib/pak/issues/693.
---
 R/http.R  | 26 ++++++++++++++++++++++++--
 R/utils.R | 18 +++++++++++-------
 2 files changed, 35 insertions(+), 9 deletions(-)

diff --git a/R/http.R b/R/http.R
index 921bec3..34371e0 100644
--- a/R/http.R
+++ b/R/http.R
@@ -1,12 +1,34 @@
+get_default_curl_options <- function(options) {
+  getopt <- function(nm) {
+    if (!is.null(v <- options[[nm]])) return(v)
+    anm <- paste0("async_http_", nm)
+    if (!is.null(v <- getOption(anm))) return(v)
+    if (!is.na(v <- Sys.getenv(toupper(anm), NA_character_))) return (v)
+  }
+  modifyList(
+    options,
+    drop_nulls(list(
+      timeout = as.integer(getopt("timeout") %||% 0),
+      connecttimeout = as.integer(getopt("connecttimeout") %||% 300),
+      low_speed_time = as.integer(getopt("low_speed_time") %||% 0),
+      low_speed_limit = as.integer(getopt("low_speed_limit") %||% 0),
+      cainfo = getopt("cainfo")
+    ))
+  )
+}
 
-http_get <- function(url) {
-  curl::curl_fetch_memory(url)
+http_get <- function(url, options = list()) {
+  handle <- curl::new_handle(url = url)
+  options <- get_default_curl_options(options)
+  curl::handle_setopt(handle, .list = options)
+  curl::curl_fetch_memory(url, handle = handle)
 }
 
 http_post <- function(url, body, headers = character(), options = list()) {
   if (!is.raw(body)) body <- charToRaw(body)
   handle <- curl::new_handle(url = url)
   curl::handle_setheaders(handle, .list = headers)
+  options <- get_default_curl_options(options)
   curl::handle_setopt(
     handle,
     customrequest = "POST",
diff --git a/R/utils.R b/R/utils.R
index 9749c85..14019da 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -80,9 +80,9 @@ contains <- function(x, y) y %in% x
 isin <- function(x, y) x %in% y
 
 remove_special <- function(list, level = 1) {
-  
+
   assert_that(is_positive_count(level))
-  
+
   if (level == 1) {
     replace(
       grepl(pattern = "^_", names(list)),
@@ -92,7 +92,7 @@ remove_special <- function(list, level = 1) {
   } else {
     lapply(list, remove_special, level = level - 1)
   }
-  
+
 }
 
 pluck <- function(list, idx) list[[idx]]
@@ -104,9 +104,9 @@ needs_packages <- function(pkgs) {
 
   if (!all(has)) {
     not_installed_pkgs <- pkgs[!has]
-    
+
     if (length(not_installed_pkgs) == 1) {
-      
+
       throw(new_error(
         "The ",
         sQuote(not_installed_pkgs),
@@ -114,7 +114,7 @@ needs_packages <- function(pkgs) {
         call. = FALSE
       ))
     } else {
-      
+
       throw(new_error(
         "The ",
         paste(sQuote(not_installed_pkgs), collapse = ", "),
@@ -122,7 +122,7 @@ needs_packages <- function(pkgs) {
         call. = FALSE
       ))
     }
-    
+
   }
 }
 
@@ -133,3 +133,7 @@ clean_description <- function(txt) {
 zap_null <- function(x) {
   x[! map_lgl(x, is.null)]
 }
+
+drop_nulls <- function (x) {
+  x[!map_lgl(x, is.null)]
+}