R/as_req.r

In hrbrmstr/splashr: Tools to Work with the 'Splash' 'JavaScript' Rendering and Scraping Service

#' Create an httr verb request function from an HAR request
#'
#' This function is very useful if you used `splashr` to find XHR requests in a dynamic
#' page and want to be able to make a call directly to that XHR resource. Once you
#' identify the proper HAR entry, pass it to this function and fully working function
#' that makes an `httr::VERB()` request will be created and returned.
#'
#' @md
#' @param entry HAR entry
#' @param quiet quiet (no messages)
#' @export
as_httr_req <- function(entry, quiet=TRUE) {

  req <- entry$request

  req$headers <- purrr::map(req$headers, "value") %>%
    setNames(map_chr(req$headers, "name"))

  ml <- getOption("deparse.max.lines")
  options(deparse.max.lines=10000)

  template <- "httr::VERB(verb = '%s', url = '%s' %s%s%s%s%s%s)"

  hdrs <- enc <- bdy <- ckies <- auth <- verbos <- cfg <- ""

  if (length(req$headers) > 0) {

    # try to determine encoding
    ct_idx <- which(grepl("content-type", names(req$headers), ignore.case=TRUE))
    if (length(ct_idx) > 0) {
      # retrieve & delete the content type
      ct <- req$headers[[ct_idx]]
      req$headers[[ct_idx]] <- NULL

      if (stringi::stri_detect_regex(ct, "multipart")) {
        enc <- ", encode = 'multipart'"
      } else if (stringi::stri_detect_regex(ct, "form")) {
        enc <- ", encode = 'form'"
      } else if (stringi::stri_detect_regex(ct, "json")) {
        enc <- ", encode = 'json'"
      } else {
        enc <- ""
      }
    }

    hdrs <- paste0(capture.output(dput(req$headers,  control=NULL)),
                   collapse="")
    hdrs <- sub("^list", ", httr::add_headers", hdrs)

  }

  if (length(req$data) > 0) {
    bdy_bits <- paste0(capture.output(dput(parse_query(req$data), control=NULL)),
                       collapse="")
    bdy <- sprintf(", body = %s", bdy_bits)
  }

  if (length(req$url_parts$username) > 0) {
    auth <- sprintf(", httr::authenticate(user='%s', password='%s')",
                    req$url_parts$username, req$url_parts$password)
  }

  if (length(req$verbose) > 0) {
    verbos <- ", httr::verbose()"
  }

  if (length(req$cookies) > 0) {
    ckies <- paste0(capture.output(dput(req$cookies, control=NULL)),
                    collapse="")
    ckies <- sub("^list", ", httr::set_cookies", ckies)
  }

  REQ_URL <- req$url

  out <- sprintf(template, toupper(req$method), REQ_URL, auth, verbos, hdrs, ckies, bdy, enc)

  # this does a half-decent job formatting the R function text
  fil <- tempfile(fileext=".R")
  on.exit(unlink(fil))
  formatR::tidy_source(text=out, width.cutoff=30, indent=4, file=fil)
  tmp <- paste0(readLines(fil), collapse="\n")

  if (!quiet) cat(tmp, "\n")

  # make a bona fide R function
  f <- function() {}
  formals(f) <- NULL
  environment(f) <- parent.frame()
  body(f) <- as.expression(parse(text=tmp))

  options(deparse.max.lines=ml)

  return(f)

}