Implementation of request signing for Amazon's S3 in R.

s3.r

library(httr)
library(digest)
library(XML)

s3_request <- function(verb, bucket, path = "/", query = NULL,
                       content = NULL, date = NULL) {
  list(
    verb = verb,
    bucket = bucket,
    path = path,
    query = query,
    content = content,
    date = date
  )
}

timestamp <- function() {
  format(Sys.time(), "%a, %d %b %Y %H:%M:%S +0000", tz = "UTC")
}
"%||%" <- function(a, b) {
  if (!is.null(a)) a else b
}

make_request <- function(request, keys) {
  host <- paste0(request$bucket, ".s3.amazonaws.com")
  url <- modify_url(paste0("http://", host, request$path),
    query = request$query)

  request$date <- request$date %||% timestamp()
  headers <- list()
  headers$Authorization <- authorization(request, headers, keys)
  headers$Date <- request$date

  list(verb = request$verb, url = url, headers = headers)
}

do <- function(request, keys) {
  req <- make_request(request, keys)
  headers_c <- add_headers(.headers = unlist(req$headers))

  if (req$verb == "GET") {
    r <- GET(req$url, config = headers_c)
  } else {
    stop(req$verb, " verb not yet supported", call. = FALSE)
  }

  res <- content(r, "text")
  xml <- xmlTreeParse(res)$doc$children[[1]]

  if (r$status != 200) {
    err <- toString(getNodeSet(xml, "//Error//Message")[[1]][[1]])
    stop("Request failed with http code ", r$status, ": \n",
      paste(strwrap(err), collapse = "\n"), call. = FALSE)
  }

  xml
}

authorization <- function(request, headers, keys) {
  if (!is.null(request$content)) {
    content_md5 <- digest(request$content, "md5")
    content_type <- request$type
  } else {
    content_md5 <- ""
    content_type <- ""
  }

  resource_canoc <- paste0("/", request$bucket, request$path)

  names(headers) <- tolower(names(headers))
  headers <- headers[order(names(headers))]
  headers_canoc <- paste0(names(headers), ":", headers, "\n")

  string <- paste0(
    toupper(request$verb), "\n",
    content_md5, "\n",
    content_type, "\n",
    request$date,
    if (length(headers) > 0) headers_canoc else "\n",
    resource_canoc
  )

  signature <- hmac_sha1(keys$secret, string)
  paste0("AWS ", keys$access, ":", signature)
}

test <- list(
  access = "AKIAIOSFODNN7EXAMPLE",
  secret = "wJalrXUtnFEMI/K7MDENG/bPxRfiCYEXAMPLEKEY")

r1 <- s3_request("GET", "johnsmith", "/photos/puppy.jpg",
  date = "Tue, 27 Mar 2007 19:36:42 +0000")
# make_request(r1, test)

keys <- list(
  access = Sys.getenv("AWS_KEY"),
  secret = Sys.getenv("AWS_SECRET_KEY"))

do(s3_request("GET", "data.had.co.nz"), keys)

Thanks for sharing this; the GET method works just fine for me (though lines 47 & 48 seem to assume the response type is XML, which seems true of error messages but isn't necessarily true if I'm just getting an arbitrary file...) and can easily be extended to the DELETE method.

Extending this to a PUT or POST method hasn't worked for me -- I see you compute md5 hashes for the signing key in that case, but I get err # 403 invalid key errors. It looks like POST methods need a more complex key, but the docs suggest all other requests should work with the http header authentication? http://docs.aws.amazon.com/AmazonS3/latest/API/sig-v4-authenticating-requests.html

Anyway, given the rather limited state of current AWS clients for R (most things just wrap the aws cli client and thus aren't very portable, and nothing on CRAN) it seems like a mature package along these lines would be very useful. Or perhaps I'm just missing something. Thanks for your thoughts. More comments along these lines here: https://discuss.ropensci.org/t/r-interface-for-aws-services/215

@hadley @leeper pointed me to his work on cloudyr, which already has a nice implementation of the newer (V4) signatures for the AWS API: https://github.com/cloudyr . We'll see where we can go from there. Thanks again for all the nice stuff httr does to facilitate this!