#' 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) }