Merge pull request #10 from mikemahoney218/detect_href

Auto-detect href vs base64 returns

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: terrainr
 Type: Package
 Title: Retrieve Data from the 'USGS' National Map and Transform it for '3D' Landscape Visualizations
-Version: 0.2.1
+Version: 0.2.1.9000
 Authors@R: 
     person(given = "Michael",
            family = "Mahoney",

NEWS.md

@@ -1,3 +1,17 @@
+# terrainr 0.2.1.9000
+* Improvements and bug fixes:
+    * All `services` arguments to `hit_national_map_api` and `get_tiles` can 
+      now handle both base64 and binary returns, removing the need to manually
+      categorize endpoints (54ad9fb).
+        * `hit_national_map_api` auto-detects whether API endpoints are 
+          returning base64 or binary and handles them appropriately
+        * `get_tiles` now auto-detects whether `hit_national_map_api` is 
+          returning base64 or binary and writes to file appropriately.
+    * `hit_national_map_api` is now more likely to fail with a human-friendly
+      error message if API endpoints return a non-200 status (54ad9fb).
+    * `hit_national_map_api` (and by extension `get_tiles`) now register a user
+      agent.
+
 # terrainr 0.2.1
 * Improvements and bug fixes:
     * The `transportation` endpoint has moved servers, and is now handled by the

R/get_tiles.R

@@ -109,10 +109,6 @@ get_tiles <- function(bbox,
   stopifnot(all(services %in% list_of_services |
     services %in% names(list_of_services)))
 
-  method <- vector("list")
-  method$href <- c("3DEPElevation", "USGSNAIPPlus", "transportation")
-  method$img <- list_of_services[!(list_of_services %in% method$href)]
-
   tif_files <- c("3DEPElevation")
   png_files <- list_of_services[!(list_of_services %in% tif_files)]
 
@@ -191,37 +187,29 @@ get_tiles <- function(bbox,
           cur_path <- final_path
         }
 
-        if (services[[k]] %in% method$href) {
-          counter <- 0
-
-          while ((!file.exists(cur_path) ||
-            file.size(cur_path) == 0) &&
-            counter < 5) {
-            img_bin <- terrainr::hit_national_map_api(
-              current_box[["bbox"]],
-              current_box[["img_width"]],
-              current_box[["img_height"]],
-              services[[k]],
-              verbose = verbose,
-              ...
-            )
-            writeBin(img_bin$imageData, cur_path)
-          }
-        } else if (services[[k]] %in% method$img) {
-          img_bin <- terrainr::hit_national_map_api(current_box[["bbox"]],
+        counter <- 0
+        while ((!file.exists(cur_path) ||
+          file.size(cur_path) == 0) &&
+          counter < 5) {
+          img_bin <- terrainr::hit_national_map_api(
+            current_box[["bbox"]],
             current_box[["img_width"]],
             current_box[["img_height"]],
             services[[k]],
             verbose = verbose,
             ...
           )
-
           outconn <- file(cur_path, "wb")
-          base64enc::base64decode(
-            what = img_bin$imageData,
-            output = outconn
+          tryCatch(
+            {
+              base64enc::base64decode(
+                what = img_bin$imageData,
+                output = outconn
+              )
+            },
+            error = function(e) writeBin(img_bin$imageData, cur_path),
+            finally = close(outconn)
           )
-          close(outconn)
         }
 
         if (georeference && services[[k]] != "3DEPElevation") {

R/hit_api.R

@@ -78,9 +78,6 @@ hit_national_map_api <- function(bbox,
     bbox <- terrainr::terrainr_bounding_box(bbox[[1]], bbox[[2]])
   }
 
-  method <- vector("list")
-  method$href <- c("3DEPElevation", "USGSNAIPPlus", "transportation")
-
   first_corner <- bbox@bl
   second_corner <- bbox@tr
 
@@ -144,56 +141,66 @@ hit_national_map_api <- function(bbox,
   # length of dots changes after that last step, so check again
   if (length(dots) > 0) query_arg <- c(query_arg, dots) # nocov
 
+  agent <- httr::user_agent("https://github.com/mikemahoney218/terrainr")
+
   # periodically res is a HTML file instead of the JSON
   # I haven't been able to capture this happening, it just crashes something
   # like 3% of the time
   # But it's non-deterministic, so we can just retry
   get_href <- function(counter = 0) {
-    res <- httr::GET(url, query = c(bbox_arg, query_arg))
-    body <- tryCatch(httr::content(res, type = "application/json"),
-      error = function(e) {
-        tryCatch(
-          {
-            res <- httr::GET(url, query = c(bbox_arg, query_arg))
-            httr::content(res, type = "application/json")
-          },
-          error = function(e) {
-            res <- httr::GET(url, query = c(bbox_arg, query_arg))
-            httr::content(res, type = "application/json")
-          }
-        )
-      }
+    backoff <- stats::runif(
+      n = 1,
+      min = 0,
+      max = floor(c(2^counter - 1, 30))
     )
+    Sys.sleep(backoff)
 
-    if (!is.null(body$error) &&
-      counter < 15 &&
-      (is.null(body$href) && service %in% method$href)) {
-      backoff <- stats::runif(n = 1, min = 0, max = floor(c(
-        2^counter - 1,
-        30
-      )))
-      Sys.sleep(backoff)
+    res <- httr::GET(url, agent, query = c(bbox_arg, query_arg))
+
+    if (!httr::http_error(res)) {
+      body <- tryCatch(
+        httr::content(res, type = "application/json"),
+        error = function(e) {
+          tryCatch(
+            {
+              res <- httr::GET(url, agent, query = c(bbox_arg, query_arg))
+              httr::content(res, type = "application/json")
+            },
+            error = function(e) {
+              res <- httr::GET(url, agent, query = c(bbox_arg, query_arg))
+              httr::content(res, type = "application/json")
+            }
+          )
+        }
+      )
+
+      if (counter < 15 && !is.null(body$error)) {
+        get_href(counter = counter + 1)
+      } else {
+        return(body)
+      }
+    } else if (counter < 15) {
       get_href(counter = counter + 1)
     } else {
-      return(body)
+      stop("Map server returned error code ", httr::status_code(img_res))
     }
   }
 
   body <- get_href()
 
-  if (service %in% method$href) {
-    img_res <- httr::GET(url = body$href)
+  if (!is.null(body$href)) {
+    img_res <- httr::GET(body$href, agent)
     counter <- 0
-    while (counter < 15 && httr::status_code(img_res) != 200) {
+    while (counter < 15 && httr::http_error(img_res)) {
       backoff <- stats::runif(n = 1, min = 0, max = floor(c(
         2^counter - 1,
         30
       )))
       Sys.sleep(backoff)
-      img_res <- httr::GET(body$href)
+      img_res <- httr::GET(body$href, agent)
     }
 
-    if (httr::status_code(img_res) != 200) {
+    if (httr::http_error(img_res)) {
       # nocov start
       stop("Map server returned error code ", httr::status_code(img_res))
       # nocov end

codemeta.json

@@ -10,7 +10,7 @@
   "codeRepository": "https://github.com/mikemahoney218/terrainr",
   "issueTracker": "https://github.com/mikemahoney218/terrainr/issues",
   "license": "https://spdx.org/licenses/MIT",
-  "version": "0.2.1",
+  "version": "0.2.1.9000",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
@@ -271,7 +271,7 @@
   ],
   "releaseNotes": "https://github.com/mikemahoney218/terrainr/blob/master/NEWS.md",
   "readme": "https://github.com/mikemahoney218/terrainr/blob/main/README.md",
-  "fileSize": "3085.971KB",
+  "fileSize": "3086.504KB",
   "contIntegration": "https://codecov.io/gh/mikemahoney218/terrainr",
   "developmentStatus": ["https://www.tidyverse.org/lifecycle/#maturing", "https://www.repostatus.org/#active"],
   "keywords": [