From 27655f34a7c7c938bdc954009c9074e150b4167e Mon Sep 17 00:00:00 2001
From: Stuart Lodge <lodge.stuart@gmail.com>
Date: Tue, 13 Oct 2020 15:01:57 +0100
Subject: [PATCH] Proposed change to s3HTTP to allow e.g 404's to be surfaced
 for S3-SELECT

---
 R/get_object.R |  5 +++++
 R/s3HTTP.R     | 17 ++++++++++++++---
 2 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/R/get_object.R b/R/get_object.R
index b15b79c..f95967a 100644
--- a/R/get_object.R
+++ b/R/get_object.R
@@ -7,6 +7,7 @@
 #' @param request_body For \code{select_object}, an XML request body as described in the \href{https://docs.aws.amazon.com/AmazonS3/latest/API/RESTObjectSELECTContent.html}{SELECT API documentation}.
 #' @param headers List of request headers for the REST call.
 #' @param parse_response Passed through to \code{\link{s3HTTP}}, as this function requires a non-default setting. There is probably no reason to ever change this.
+#' @param do_standalone_check_for_http_errors Passed through to \code{\link{s3HTTP}}, as this function requires a non-default setting. There is probably no reason to ever change this.
 #' @param as Passed through to \code{httr::content}. 
 #' @template dots
 #' @details \code{get_object} retrieves an object into memory as a raw vector. This page describes \code{get_object} and several wrappers that provide additional useful functionality.
@@ -80,6 +81,7 @@ function(object,
          bucket, 
          headers = list(), 
          parse_response = FALSE, 
+         do_standalone_check_for_http_errors = FALSE,
 		 as = "raw",
          ...) {
     if (missing(bucket)) {
@@ -91,6 +93,7 @@ function(object,
                 path = paste0("/", object),
                 headers = headers,
                 parse_response = parse_response,
+                do_standalone_check_for_http_errors = do_standalone_check_for_http_errors,
                 ...)
     cont <- httr::content(r, as = as)
     return(cont)
@@ -136,6 +139,7 @@ function(
   request_body,
   headers = list(),
   parse_response = FALSE,
+  do_standalone_check_for_http_errors = TRUE,
   ...
 ) {
     if (missing(bucket)) {
@@ -150,6 +154,7 @@ function(
                 query = list(select = "", "select-type" = "2"),
                 request_body = request_body,
                 parse_response = parse_response,
+                do_standalone_check_for_http_errors = do_standalone_check_for_http_errors,
                 ...)
     cont <- httr::content(r, as = "raw")
     return(cont)
diff --git a/R/s3HTTP.R b/R/s3HTTP.R
index 503c64c..7d35e8e 100644
--- a/R/s3HTTP.R
+++ b/R/s3HTTP.R
@@ -22,6 +22,7 @@
 #' @param secret A character string containing an AWS Secret Access Key. If missing, defaults to value stored in environment variable \env{AWS_SECRET_ACCESS_KEY}.
 #' @param session_token Optionally, a character string containing an AWS temporary Session Token. If missing, defaults to value stored in environment variable \env{AWS_SESSION_TOKEN}.
 #' @param use_https Optionally, a logical indicating whether to use HTTPS requests. Default is \code{TRUE}.
+#' @param do_standalone_check_for_http_errors A logical indicating whether to check for HTTP error status codes. If \code{parse_response} is \code{TRUE} then this is ignored. Default is \code{FALSE}.
 #' @param ... Additional arguments passed to an HTTP request function. such as \code{\link[httr]{GET}}.
 #' @return the S3 response, or the relevant error.
 #' @import httr
@@ -52,6 +53,7 @@ function(verb = "GET",
          secret = NULL, 
          session_token = NULL,
          use_https = TRUE,
+         do_standalone_check_for_http_errors = FALSE,
          ...) {
     
     # locate and validate credentials
@@ -224,9 +226,15 @@ function(verb = "GET",
     # handle response, failing if HTTP error occurs
     if (isTRUE(parse_response)) {
         out <- parse_aws_s3_response(r, Sig, verbose = verbose)
+        check_aws_s3_status(r, Sig, out, verbose = verbose)
     } else {
+        # even if we don't parse the response, we can still check for HTTP errors
+        if (isTRUE(do_standalone_check_for_http_errors)) {
+            check_aws_s3_status(r, Sig, verbose = verbose)
+        }
         out <- r
     }
+
     attributes(out) <- c(attributes(out), httr::headers(r))
     out
 }
@@ -247,6 +255,11 @@ parse_aws_s3_response <- function(r, Sig, verbose = getOption("verbose")){
     } else {
         response <- r
     }
+    
+    return(response)
+}
+
+check_aws_s3_status <- function(r, Sig, response = NULL, verbose = getOption("verbose")) {
     if (isTRUE(verbose)) {
         message(httr::http_status(r)[["message"]])
     }
@@ -259,11 +272,9 @@ parse_aws_s3_response <- function(r, Sig, verbose = getOption("verbose")){
         print(out)
         httr::stop_for_status(r)
     }
-    return(response)
 }
 
-setup_s3_url <- 
-function(bucketname, 
+setup_s3_url <- function(bucketname, 
          region, 
          path, 
          accelerate = FALSE,