R/api.R

In shunsambongi/wpr: R interface for WordPress REST API

user_agent <- httr::user_agent("https://github.com/shunsambongi/wpapi")

# URL ---------------------------------------------------------------------

wordpress_base_url <- function() {
  url <- Sys.getenv("WORDPRESS_URL")
  if (identical(url, "")) {
    stop(
      "Please set environment variable WORDPRESS_URL to your WordPress URL",
      call. = FALSE
    )
  }
  url
}

wordpress_rest_url <- function(base_url = wordpress_base_url()) {
  resp <- httr::GET(base_url, user_agent)

  if (httr::http_type(resp) != "text/html") {
    stop("WordPress URL did not return HTML", call. = FALSE)
  }

  html <- xml2::read_html(httr::content(resp, "text"))
  xpath <- "//link[contains(@rel, 'https://api.w.org') and @href]"
  node <- xml2::xml_find_first(html, xpath)
  if (is.na(node)) {
    stop("Cannot determine URL for WordPress REST API", call. = FALSE)
  }
  xml2::xml_attr(node, "href")
}

wordpress_endpoint <- function(path, rest_url = wordpress_rest_url(), .envir = parent.frame()) {
  path <- c("wp", "v2", glue::glue(path, .envir = .envir))
  url <- httr::parse_url(rest_url)


  format_path <- function(path) {
    paste0("/", paste(gsub("^/", "", path), collapse = "/"))
  }

  if (is.null(url$query$rest_route)) {
    url$path <- format_path(c("wp-json", path))
  } else {
    url$query <- list("rest_route" = format_path(path))
  }
  httr::build_url(url)
}



# WordPress API -----------------------------------------------------------

wordpress_api <- function(verb, path, ...,
                          rest_url = wordpress_rest_url(), .envir = parent.frame()) {
  url <- wordpress_endpoint(path, rest_url = rest_url, .envir = .envir)

  resp <- httr::VERB(
    verb = verb,
    url = url,
    user_agent,
    ...
  )

  if (httr::http_type(resp) != "application/json") {
    stop("API did not return json", call. = FALSE)
  }

  parsed <- jsonlite::fromJSON(
    httr::content(resp, "text"),
    simplifyVector = FALSE
  )

  if (httr::http_error(resp)) {
    # TODO use rlang::abort
    stop(
      sprintf(
        "WordPress API request failed [%s]\n%s\n<%s>",
        httr::status_code(resp),
        as_json(parsed),
        "https://developer.wordpress.org/rest-api/"
      ),
      call. = FALSE
    )
  }

  structure(
    list(
      content = parsed,
      url = url,
      response = resp
    ),
    class = "wordpress_api"
  )
}

#' @export
print.wordpress_api <- function(x, ..., format = c("json", "str")) {
  url <- httr::parse_url(x$url)
  if (is.null(url$query$rest_route)) {
    path <- gsub("^/?", "/", url$path)
  } else {
    path  <- paste0("?rest_route=", gsub("^/?", "/", url$query$rest_route))
  }
  cat("<WordPress ", path, ">\n", sep = "")
  format <- match.arg(format)
  switch(format,
    json = print(as_json(x$content)),
    str = utils::str(x$content),
    stop(paste0("Invalid format: ", format), call. = FALSE)
  )
  invisible(x)
}

as_json <- function(x) {
  jsonlite::toJSON(x, auto_unbox = TRUE, pretty = TRUE)
}


# verbs -------------------------------------------------------------------

GET <- function(path, ..., .envir = parent.frame()) {
  wordpress_api(verb = "GET", path = path, ..., .envir = .envir)
}

POST <- function(path, ..., .envir = parent.frame()) {
  wordpress_api(verb = "POST", path = path, ..., .envir = .envir)
}

DELETE <- function(path, ..., .envir = parent.frame()) {
  wordpress_api(verb = "DELETE", path = path, ..., .envir = .envir)
}