R/pxweb_add_config.R

In pxweb: R Interface to PXWEB APIs

#' Add the config slot to a pxweb object
#' 
#' @details 
#' Checks if there exist a config object in the object. 
#' Otherwise it query the api to get it and add that call to the call stack.
#' 
#' @param obj an object to add config to
#' 
#' @keywords internal
pxweb_add_config <-function(obj){
  assert_pxweb_url(obj)
  assert_pxweb_rda_file_path(obj)
  
  if(inherits(obj, "pxweb")){
    return(obj)
  }

  if(file.exists(obj$paths$rda_file_path)){
    obj$config <- load_pxweb_config(obj)
    return(obj)
  }
  
  # Do a call to get the cfg and check if PXWEB API
  # Add that one call has been made
  call_time_stamp <- Sys.time()
  cfg_url <- build_pxweb_config_url(obj)
  r <- httr::GET(cfg_url)
  pxweb_http_log_response(r)
  
  # Check that we get a config back

  if(!is_pxweb_config_response(r)){
    base_url <- build_pxweb_url(obj)
    r2 <- httr::GET(base_url)
    pxweb_http_log_response(r2)
    if(is_pxweb_response(r2)){
      stop(paste0("\nThis is an old PXWEB API not supported by pxweb R package\n(version PX-Web 2014 Dec R1 or later is supported): \n", httr::build_url(obj$url)), call. = FALSE)
    } else {
      stop(paste0("\nThis is not a PXWEB API: \n", httr::build_url(obj$url)), call. = FALSE)
    }
  } 
  
  httpwr <- http_was_redirected(r)
  if(httpwr$was_redirected){
    warning("PXWEB URL CHANGE:\n from: ", httpwr$redirected_from, "\n to:   ", httpwr$redirected_to, call. = FALSE)
  }
  
  cfg <- httr::content(r, "parsed")
  obj$config <- list(calls_per_period = cfg$maxCalls,
                     period_in_seconds = cfg$timeWindow,
                     max_values_to_download = cfg$maxValues,
                     CORS = cfg$CORS)

  # Add the call to the stack
  obj <- pxweb_add_call(obj, call_time_stamp)
  obj
}


#' Check if a response is a pxweb config response
#' 
#' @param x a response object
#' @keywords internal
is_pxweb_config_response <- function(x){
  checkmate::assert_class(x, "response")
  if(httr::http_error(x)) return(FALSE)
  cfg <- suppressMessages(try(httr::content(x, "parsed"), silent = TRUE))
  (all(c("maxValues", "maxCalls", "timeWindow", "CORS") %in% names(cfg))) & !inherits(cfg, "try-error")
}



#' http_was_redirected
#'
#' @param response an httr response object, e.g. from a call to httr::GET()
#'
#' @return list with slots \code{was_redirected}, \code{redirected_from} and  \code{redirected_to}
#'
#' @references 
#' Function in large parts taken from \url{https://petermeissner.de/blog/2018/11/07/using-httr-to-detect-redirects/}.
#'
#' @examples 
#' \dontrun{
#'   r <- httr::GET("http://httpbin.org/redirect/2")
#'   pxweb:::http_was_redirected(r)
#' }
#' @keywords internal
http_was_redirected <- function(r){
  checkmate::assert_class(r, "response")

    # extract status 
    status <- 
      vapply(
        X         = r$all_headers, 
        FUN       = `[[`, 
        FUN.VALUE = integer(1),
        "status"
      )
      
    # Remove config etc
    redirected_from <- httr::parse_url(r$request$url)
    redirected_from$params <- NULL
    redirected_from$query <- NULL
    redirected_from$fragment <- NULL
    redirected_from$username <- NULL
    redirected_from$password <- NULL
    redirected_to <- httr::parse_url(r$url)
    redirected_to$params <- NULL
    redirected_to$query <- NULL
    redirected_to$fragment <- NULL
    redirected_to$username <- NULL
    redirected_to$password <- NULL
    
    # check domains in location against original domain
    list(was_redirected = any(status >= 300 & status < 400),
         redirected_from = httr::build_url(redirected_from),
         redirected_to = httr::build_url(redirected_to))
}