Merge pull request #108 from Rafnuss/99-httpr-httpr2

httr -> httr2
Rafnuss · Nov 3, 2023 · 1fb966c · 1fb966c
2 parents 7b2d041 + dffeaee
commit 1fb966c
Show file tree

Hide file tree

Showing 8 changed files with 127 additions and 125 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: GeoPressureR
 Title: Global Positioning by Atmospheric Pressure
-Version: 3.1.4
+Version: 3.1.5
 Authors@R: c(
     person("Raphaël", "Nussbaumer", , "rafnuss@gmail.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-8185-1020")),
@@ -23,15 +23,14 @@ Imports:
     geosphere,
     glue,
     ggplot2,
-    httr,
+    httr2,
     leaflet,
     plotly,
     jsonlite,
     Matrix,
     methods,
     ncdf4,
     pracma,
-    readr,
     stats,
     terra,
     utils

diff --git a/NEWS.md b/NEWS.md
@@ -1,13 +1,19 @@
-# GeoPressureR v3.1.2
+# GeoPressureR v3.1.5
 ## Major
-*  
+- Fix major bugs https://github.com/Rafnuss/GeoPressureR/pull/103/commits/05c3203ef1588bbc1f769050377cadf5f1aadcbd
+- Update to GeoPressureAPI v2 for `geopressure_timeseries()` https://github.com/Rafnuss/GeoPressureR/pull/103/commits/732d1a02cc241dc7d2dde3401c8747fa860650c6
+- Add `workers` argument in `graph_create()` https://github.com/Rafnuss/GeoPressureR/commit/e1ce45882809e1fd3da0e8feb2ff80ac70f2bf8b
+- Edit default number of workers for `graph_create()` https://github.com/Rafnuss/GeoPressureR/pull/106/commits/256c5756e3eeb27ebac82b6c5a61b6cfb23425da
+- Migrate from `httr`to `httr2` 
 
 ## Minor
-* Add `workers` argument in `graph_create()` https://github.com/Rafnuss/GeoPressureR/commit/e1ce45882809e1fd3da0e8feb2ff80ac70f2bf8b
-* Update to GeoPressureAPI v2 for `geopressure_timeseries()` https://github.com/Rafnuss/GeoPressureR/commit/732d1a02cc241dc7d2dde3401c8747fa860650c6
+- Add `codemeta.json` https://github.com/Rafnuss/GeoPressureR/pull/105/commits/4f7f7bce8875b4af59db3fc1ce403d41d6317469
+- Add project status badge https://github.com/Rafnuss/GeoPressureR/pull/105/commits/ecd8f61ec49dcd376748e54d19dfb2000675d302
+- Fix leaflet tile provider with Stadia change https://github.com/Rafnuss/GeoPressureR/pull/106/commits/8d9bd159874deb87d61907ea14911eca12877038
 
+**Full Changelog**: https://github.com/Rafnuss/GeoPressureR/compare/v3.1.5...v3.1.0
 ## Full Changelog
-[https://github.com/Rafnuss/GeoPressureR/compare/v3.2.1...v3.1.2](https://github.com/Rafnuss/GeoPressureR/compare/v3.1.0...v3.1.2)
+[https://github.com/Rafnuss/GeoPressureR/compare/v3.1.5...v3.1.0](https://github.com/Rafnuss/GeoPressureR/compare/v3.1.5...v3.1.0)
 
 
 # GeoPressureR v3.1

diff --git a/R/geopressure_map.R b/R/geopressure_map.R
@@ -104,7 +104,7 @@
 #' @param keep_mask logical defining if the mask map is returned in `tag`.
 #' @param keep_mse logical defining if the MSE map is returned in `tag`.
 #' @param timeout Duration before the code is interrupted both for the request on
-#' GeoPressureAPI and on GEE (in seconds, see [`httr::timeout()`]).
+#' GeoPressureAPI and on GEE (in seconds, see `httr2::req_timeout()`).
 #' @param workers Number of parallel requests on GEE. Integer between 1 and 99. `"auto"` adjust the
 #' number of workers to the number of `stap_elev` to query.
 #' @param compute_known logical defining if the map(s) for known stationary period should be

diff --git a/R/geopressure_map_mismatch.R b/R/geopressure_map_mismatch.R
@@ -14,7 +14,7 @@ geopressure_map_mismatch <- function(tag,
   # Check tag
   tag_assert(tag, "setmap")
 
-  # Format query
+  # Assert input
   assertthat::assert_that(is.numeric(max_sample))
   assertthat::assert_that(0 < max_sample)
   assertthat::assert_that(is.numeric(margin))
@@ -24,6 +24,8 @@ geopressure_map_mismatch <- function(tag,
   assertthat::assert_that(thr_mask >= 0 & thr_mask <= 1)
   assertthat::assert_that(is.numeric(timeout))
   assertthat::assert_that(is.numeric(workers) | workers == "auto")
+  assertthat::assert_that(is.logical(debug))
+  assertthat::assert_that(is.logical(quiet))
 
   if (!quiet) {
     cli::cli_progress_step("Pre-process pressure data")
@@ -47,65 +49,49 @@ geopressure_map_mismatch <- function(tag,
   )
 
   if (debug) {
-    temp_file <- tempfile("log_geopressure_map_mismatch_", fileext = ".json")
+    temp_file <- tempfile("log_geopressure_map_", fileext = ".json")
     write(jsonlite::toJSON(body, auto_unbox = TRUE, pretty = TRUE), temp_file)
     cli::cli_text("Body request file: {.file {temp_file}}")
   }
 
-  # Request URLS
   if (!quiet) {
     cli::cli_progress_step("Generate requests for {.val {length(unique(pres$stapelev))}} stapelev \\
                            (on GeoPressureAPI): {.field {unique(pres$stapelev)}}")
   }
-  res <- httr::POST("https://glp.mgravey.com/GeoPressure/v2/map/",
-    body = body,
-    encode = "json",
-    httr::timeout(timeout),
-    httr::config(
-      verbose = debug # httr::verbose(data_out = TRUE, data_in = FALSE, info = TRUE, ssl = FALSE)
-    )
-  )
 
-  if (httr::http_error(res)) {
-    temp_file <- tempfile("log_geopressure_map_mismatch_", fileext = ".json")
-    write(jsonlite::toJSON(body), temp_file)
-    # nolint start
-    if (httr::status_code(res) == 400 || httr::status_code(res) == 400) {
-      # message(httr::content(res))
-      github_link <- glue::glue(
-        "https://github.com/Rafnuss/GeoPressureAPI/issues/new?title=crash\\%20geopressure_map%20\\
-      task_id:{httr::content(res)$taskID}&labels=crash"
-      )
-      cli::cli_abort(c(
-        "x" = "Error (Status code {.val {httr::status_code(res)}}) with your request on \\
-        {.url https://glp.mgravey.com/GeoPressure/v2/map/}.",
-        ">" = httr::content(res)$errorMessage,
-        "i" = "Please try again, and if the problem persists, file an issue on Github: \\
-        {.url {github_link}} with the request body file located on your computer: \\
-        {.file {temp_file}}"
-      ))
-    } else {
-      github_link <- glue::glue(
-        "https://github.com/Rafnuss/GeoPressureAPI/issues/new?title=crash\\%20geopressure_map%20\\
-      &labels=crash"
+  # Request URLS
+  req <- httr2::request("https://glp.mgravey.com/GeoPressure/v2/map/") |>
+    httr2::req_body_json(body) |>
+    httr2::req_timeout(timeout) |>
+    httr2::req_retry(max_tries = 3) |>
+    httr2::req_error(body = function(resp) {
+      if (debug) {
+        print(httr2::resp_body_json(resp))
+      }
+      c(
+        "x" = "Error with your request on https://glp.mgravey.com/GeoPressure/v2/map/.",
+        ">" = httr2::resp_body_json(resp)$errorMessage,
+        "i" = "Please try again with `debug=TRUE`"
       )
-      print(res)
-      cli::cli_abort(c(
-        "x" = "Error (Status code {.val {httr::status_code(res)}}) with your request on \\
-        {.url https://glp.mgravey.com/GeoPressure/v2/map/}.",
-        "i" = "Please try again, and if the problem persists, file an issue on Github: \\
-        {.url {github_link}} with the request body file located on your computer: \\
-        {.file {temp_file}}"
-      ))
-    }
-    # nolint end
+    })
+
+  if (debug) {
+    req <- httr2::req_verbose(req)
+  }
+
+  # Perform the request and convert the response to json
+  resp <- httr2::req_perform(req)
+  resp_json <- httr2::resp_body_json(resp)
+
+  if (debug) {
+    print(resp_json)
   }
 
   # Get urls
-  urls <- httr::content(res)$data$urls
+  urls <- resp_json$data$urls
   urls[sapply(urls, is.null)] <- NA
   urls <- unlist(urls)
-  labels <- unlist(httr::content(res)$data$labels)
+  labels <- unlist(resp_json$data$labels)
 
   if (debug) {
     cli::cli_text("urls: ")
@@ -148,8 +134,7 @@ geopressure_map_mismatch <- function(tag,
     cli::cli_progress_step(
       msg = "Compute (on GEE server) and download .geotiff for {.val {length(urls)}} stapelev \\
       (in parallel): {.val {labels[i_u]}} | {i_u}/{length(urls)}",
-      msg_done = "Compute (on GEE server) and download .geotiff for {.val {length(urls)}} stapelev",
-      spinner = TRUE
+      msg_done = "Compute (on GEE server) and download .geotiff for {.val {length(urls)}} stapelev"
     )
     # nolint end
   }
@@ -158,21 +143,22 @@ geopressure_map_mismatch <- function(tag,
       cli::cli_progress_update(force = TRUE)
     }
     f[[i_u]] <- future::future(expr = {
-      file <- tempfile(fileext = ".geotiff")
-      res <- httr::GET(
-        urls[i_u],
-        httr::write_disk(file),
-        httr::timeout(timeout),
-        httr::config(
-          verbose = debug
-          # httr::verbose(data_out = TRUE, data_in = FALSE, info = TRUE, ssl = FALSE)
-        )
-      )
-      if (httr::http_error(res)) {
-        return(res)
-      } else {
-        return(file)
+      # Request URLS
+      req <- httr2::request(urls[i_u]) |>
+        httr2::req_timeout(timeout) |>
+        httr2::req_retry(max_tries = 3) |>
+        httr2::req_error(is_error = function(resp) FALSE)
+
+      if (debug) {
+        req <- httr2::req_verbose(req)
       }
+
+      # Perform the request and write the response to file
+      file <- tempfile(fileext = ".geotiff")
+      httr2::req_perform(req, path = file)
+
+      # return the path to the file
+      return(file)
     }, seed = TRUE)
   }
 
@@ -193,22 +179,10 @@ geopressure_map_mismatch <- function(tag,
       cli::cli_progress_update(force = TRUE)
     }
     file <- future::value(f[[i_u]])
-    if (inherits(file, "response")) {
-      cli::cli_warn(c(
-        "x" = "There was an error for stap {.val {labels[i_u]}} during the downloading and \\
-        reading of the response url {.url {urls[i_u]}}. It returned a status code \\
-        {.val {httr::status_code(res)}}."
-      ))
-      print(res)
-    } else {
-      if (debug) {
-        print(file)
-      }
-      map[[i_u]] <- terra::rast(file)
-      names(map[[i_u]][[1]]) <- "map_pressure_mse"
-      if (keep_mask) {
-        names(map[[i_u]][[2]]) <- "map_pressure_mask"
-      }
+    map[[i_u]] <- terra::rast(file)
+    names(map[[i_u]][[1]]) <- "map_pressure_mse"
+    if (keep_mask) {
+      names(map[[i_u]][[2]]) <- "map_pressure_mask"
     }
   }
 

diff --git a/R/geopressure_timeseries.R b/R/geopressure_timeseries.R
@@ -37,13 +37,16 @@
 #' the timeseries as POSIXlt.
 #' @inheritParams geopressure_map
 #' @param quiet logical to hide messages about the progress
+#' @param debug logical to display additional information to debug a request
+#'
 #' @return A data.frame containing
 #' - `date` POSIXct date time
 #' - `pressure_era5` pressure (hPa)
 #' - `lon` same as input `lon` except if over water
 #' - `lat` same as input `lat` except if over water.
 #' - `pressure_era5_norm` only if `pressure` is provided as input
 #' - `altitude` only if `pressure` is provided as input
+#'
 #' @examples
 #' # Request pressure at a given location
 #' pressurepath <- geopressure_timeseries(
@@ -87,7 +90,8 @@ geopressure_timeseries <- function(lat,
                                    start_time = NULL,
                                    end_time = NULL,
                                    timeout = 60 * 5,
-                                   quiet = FALSE) {
+                                   quiet = FALSE,
+                                   debug = FALSE) {
   # Check input
   assertthat::assert_that(is.numeric(lon))
   assertthat::assert_that(is.numeric(lat))
@@ -120,53 +124,65 @@ geopressure_timeseries <- function(lat,
   }
 
   if (!quiet) cli::cli_progress_step("Generate request (on GeoPressureAPI)")
-  res <- httr::POST("https:///glp.mgravey.com/GeoPressure/v2/timeseries/",
-    body = body,
-    encode = "json",
-    httr::timeout(timeout)
-  )
-
-  if (httr::http_error(res)) {
-    message(httr::http_status(res)$message)
-    message(httr::content(res))
-    temp_file <- tempfile("log_pressurepath_create", fileext = ".json")
-    write(jsonlite::toJSON(body), temp_file)
-    cli::cli_abort(c(
-      x = "Error with your request on {.url https://glp.mgravey.com/GeoPressure/v2/timeseries/}.",
-      i = "Please try again, and if the problem persists, file an issue on Github {.url \\
-      https://github.com/Rafnuss/GeoPressureAPI/issues/new?body=pressurepath_create&labels=crash}
-      with this log file located on your computer: {.file {temp_file}}."
-    ))
+
+  if (debug) {
+    temp_file <- tempfile("log_geopressure_timeseries_", fileext = ".json")
+    write(jsonlite::toJSON(body, auto_unbox = TRUE, pretty = TRUE), temp_file)
+    cli::cli_text("Body request file: {.file {temp_file}}")
+  }
+
+  req <- httr2::request("https://glp.mgravey.com/GeoPressure/v2/timeseries/") |>
+    httr2::req_body_json(body) |>
+    httr2::req_timeout(timeout) |>
+    httr2::req_retry(max_tries = 3) |>
+    httr2::req_error(body = function(resp) {
+      if (debug) {
+        print(httr2::resp_body_json(resp))
+      }
+      c(
+        "x" = "Error with your request on https://glp.mgravey.com/GeoPressure/v2/timeseries/.",
+        ">" = httr2::resp_body_json(resp)$errorMessage,
+        "i" = "Please try again with `debug=TRUE`"
+      )
+    })
+
+  if (debug) {
+    req <- httr2::req_verbose(req)
   }
 
-  # Retrieve response data
-  res_data <- httr::content(res)$data
+  # Perform the request and convert the response to json
+  resp <- httr2::req_perform(req)
+  resp_data <- httr2::resp_body_json(resp)$data
 
   # Check for change in position
-  if (res_data$distInter > 0) {
+  if (resp_data$distInter > 0) {
     cli::cli_inform(c("!" = "Requested position is on water and will be move to the closet point \\
-      on shore ({.url https://www.google.com/maps/dir/{lat},{lon}/{res_data$lat},{res_data$lon}}) \\
-      located {round(res_data$distInter / 1000)} km away.\f"))
+      on shore \\
+      ({.url https://www.google.com/maps/dir/{lat},{lon}/{resp_data$lat},{resp_data$lon}}) \\
+      located {round(resp_data$distInter / 1000)} km away.\f"))
   }
 
-  # Download the csv file
   if (!quiet) cli::cli_progress_step("Sending request")
-  res2 <- httr::GET(res_data$url, httr::timeout(timeout))
 
-  # read csv
-  if (!quiet) {
-    cli::cli_progress_step("Compute timeseries (on GEE server) and download csv")
+  # Prepare request
+  req <- httr2::request(resp_data$url) |>
+    httr2::req_timeout(timeout) |>
+    httr2::req_retry(max_tries = 3)
+
+  if (debug) {
+    req <- httr2::req_verbose(req)
   }
-  out <- as.data.frame(httr::content(res2,
-    type = "text/csv",
-    encoding = "UTF-8",
-    show_col_types = FALSE
-  ))
+
+  # Perform request
+  resp <- httr2::req_perform(req)
+
+  # Convert the response to data.frame
+  out <- utils::read.csv(text = httr2::resp_body_string(resp))
 
   # check for errors
   if (nrow(out) == 0) {
     temp_file <- tempfile("log_pressurepath_create", fileext = ".json")
-    write(jsonlite::toJSON(body), temp_file)
+    write(jsonlite::toJSON(body, auto_unbox = TRUE, pretty = TRUE), temp_file)
     cli::cli_abort(c(
       x = "Returned csv file is empty.",
       i = "Check that the time range is none-empty. Log of your  JSON request: {.file {temp_file}}"
@@ -182,8 +198,8 @@ geopressure_timeseries <- function(lat,
   names(out)[names(out) == "pressure"] <- "pressure_era5"
 
   # Add exact location
-  out$lat <- res_data$lat
-  out$lon <- res_data$lon
+  out$lat <- resp_data$lat
+  out$lon <- resp_data$lon
 
   # Compute the ERA5 pressure normalized to the pressure level (i.e. altitude) of the bird
   if (!is.null(pressure)) {