R/bls_request.R

In blsR: Make Requests from the Bureau of Labor Statistics API

#' Retrieve Data From the U.S. Bureau Of Labor Statistics API v2
#'
#' @description
#'
#' `bls_request()`  will execute queries against the BLS API. Queries are
#' generated using one of the following query-generating functions:
#' [query_series()], [query_n_series()], [query_popular_series()],
#' [query_all_surveys()], [query_survey_info()], [query_latest_observation()].
#' The result is the "Results" block as defined in the API v2 signatures at
#' <https://www.bls.gov/developers/api_signature_v2.htm>
#'
#' @param query list generated by one of the query generating functions
#' @param api_key Optional. An API key string. Defaults to the value returned by
#' [`bls_get_key()`]. The preferred way to provide an API key is to use
#' [`bls_set_key()`] or the `BLS_API_KEY` environment variable. Manually passing
#' the key will be deprecated in future releases.
#' @param user_agent string, optional
#' @param process_response function, optional. processes the `httr` response
#'  object. The default function will return the JSON payload parsed into a list
#' @param ... further arguments will be passed to `process_response` when called
#'
#' @return a list of information returned by the API request
#'
#' @family blsR-requests
#'
#' @export
#'
#' @examples
#' \dontrun{
#' library(blsR)
#' uer_query <- query_series('LNS14000000') #monthly unemployment rate series
#' uer_results <- bls_request(uer_query) #API response
#' }


bls_request <- function(
  query,
  api_key = bls_get_key(),
  user_agent = 'http://github.com/groditi/blsR',
  process_response = .process_response,
  ...
){
  ua <-  httr::user_agent(user_agent)
  url <- httr::parse_url(query$url)
  #the query object should contain all it needs to make the request except
  #the BLS API key. simple requests that don't need it should be run even if
  #its missing but for complex ones with multiple series requested it should
  #inject the  key into the payload

  if(query$is_complex == FALSE){
    if(!is.null(api_key))
      url <- httr::modify_url(url, query = c(url$query, list(registrationkey = api_key)))

    response <- httr::GET(url, ua)
  } else{
    if('payload' %in% names(query)){
      if('seriesid' %in% names(query$payload)){
        if(is.null(api_key))
          rlang::warn('api_key is required for multiple series requests.')
        query$payload[['registrationkey']] <- api_key
        query$payload$seriesid <- I(query$payload$seriesid)
      }
    }

    response <- httr::POST(url=url, ua, body=query$payload, encode="json")
  }

  return(process_response(response, ...))
}

.process_response <- function(response, ...){

  #die if the format of the response content isnt json
  if(httr::http_type(response) != "application/json"){
    rlang::abort("http request did not return json")
  }

  json_response <- httr::content(response, simplifyVector=FALSE, ...)

  #die if request wasn't successful
  if(json_response$status != 'REQUEST_SUCCEEDED') {
    rlang::abort(paste(json_response$message, '; '))
  }
  purrr::walk(json_response$message, rlang::inform, call = rlang::current_env)

  return(json_response$Results)
}