#' Send a request to the Qualtrics API
#'
#' `request` is a lower-level function for direct access to API actions. It may
#' be useful in programming.
#'
#' For help with subdomains, see the
#' \href{https://api.qualtrics.com/docs/root-url}{Qualtrics documentation}. Each
#' Qualtrics account is assigned a subdomain, and using another will work but
#' produce a warning.
#'
#' @inheritParams httr::VERB
#' @param action Either an API action (like \code{"surveys"}) or a complete API
#' URL.
#' @param token A Qualtrics API token (by default, the value of the environment
#' variable \code{QUALTRICS_TOKEN}).
#' @param subdomain A Qualtrics subdomain (by default, the value of the
#' environment variable \code{QUALTRICS_SUBDOMAIN}). Ignored if \code{action}
#' is a complete API URL.
#' @param verbose Output API calls to \code{\link[base]{stderr}}.
#' @param ... Further arguments to the function given by \code{verb}, e.g.,
#' \code{\link[httr]{GET}}.
#'
#' @return For \code{request}, a \code{\link[httr]{response}} object. For
#' \code{qget} and \code{qpost}, its content as extracted by
#' \code{\link[httr]{content}}.
#' @importFrom httr GET POST VERB add_headers content modify_url stop_for_status
#' @export
#' @examples
#' \dontrun{
#' response <- request("GET", "surveys")
#' }
request <- function(verb = c("GET", "POST", "PUT", "DELETE"),
action,
token = Sys.getenv("QUALTRICS_TOKEN"),
subdomain = Sys.getenv("QUALTRICS_SUBDOMAIN"),
verbose = FALSE,
...) {
token <- read_if_missing("QUALTRICS_TOKEN", token)
subdomain <- read_if_missing("QUALTRICS_SUBDOMAIN", subdomain)
verb <- match.arg(verb)
assert_that(is_text(verb))
assert_that(is_text(action))
assert_that(is_text(subdomain))
assert_that(is.flag(verbose))
api_url <- parse_action(action, subdomain)
if (verbose) {
message("Sending ", verb, " request to ", api_url)
}
response <- httr::VERB(verb,
api_url,
add_qheaders(token),
encode = ifelse(identical(verb, "POST"), "json", NULL),
...)
stop_for_status(response)
warn_on_notice(response)
return(response)
}
read_if_missing <- function(key, value, ...) {
# If argument 'value' is empty, try using read_config() to get a valid
# value.
if (!is_text(value)) {
config <- read_config(select = key, setenv = FALSE, ...)
stopifnot(length(config) == 1)
stopifnot(key %in% names(config))
return(config[[key]])
} else {
return(value)
}
}
stop_for_status <- function(response) {
# Provide user-friendly stop() messages for some error codes. Catch all other
# errors with httr::stop_for_status().
#
# @param response A httr response object.
status_message <- paste0("The Qualtrics API responded \"",
httr::http_status(response)$message, "\". ")
please_report <- c("If you aren't programming your own requests with ",
"request(), please report this error at ",
"<https://github.com/cloudyr/qualtrics/issues>.")
assert_that(has_name(response, "status_code"))
code <- response$status_code
assert_that(is.numeric(code))
if (code %in% c(400, 413)) {
# Bad Request, Payload Too Large
stop(status_message, please_report)
} else if (code == 404) {
# Not Found
stop("Requested <", response$request$url, ">. ", status_message,
please_report)
} else if (code == 401) {
# Unauthorized
stop(status_message, "Please check your API token.")
} else if (code == 429) {
# Too Many Requests
stop(status_message, "You have reached the request rate limit.")
} else if (code >= 500) {
# Server Error
stop(status_message, "You may want to contact Qualtrics Support at ",
"<https://www.qualtrics.com/contact>.")
}
httr::stop_for_status(response)
}
warn_on_notice <- function(response) {
# If the meta element of the request response content has a 'notice' element,
# pass it on to the user as a warning. Known to happen if an incorrect
# subdomain is used.
assert_that(inherits(response, "response"))
content <- httr::content(response)
if ("meta" %in% names(content) && "notice" %in% names(content$meta)) {
warning(content$meta$notice)
}
}
add_qheaders <- function(token) {
# Add Qualtrics headers to a httr request
assert_that(is_token(token))
httr::add_headers("content_type" = "application/json", "x-api-token" = token)
}
parse_action <- function(action, subdomain) {
# Determine whether 'action' gives the name of an action (e.g. "surveys") or a
# complete API URL.
assert_that(is_text(action))
if (is_action(action)) {
# action gives a known action; construct the rest of the URL
api_url <- build_api_url(action, subdomain)
} else {
# action should give a complete URL; check that it has a hostname and path
check_api_url(action)
api_url <- action
}
return(api_url)
}
build_api_url <- function(action, subdomain, query = NULL) {
# Build a Qualtrics API URL from specified and fixed parts
assert_that(is_text(action))
assert_that(is_text(subdomain))
httr::modify_url("",
scheme = "https",
hostname = paste(subdomain, "qualtrics.com", sep = "."),
path = paste("API/v3", action, sep = "/"),
query = query)
}
check_api_url <- function(url_string) {
assert_that(is_text(url_string))
parsed <- httr::parse_url(url_string)
error_stem <- paste0("\"", url_string, "\" ",
"is not a valid Qualtrics API URL.")
error_stub <- "For more see help('request')."
if (!length(parsed$hostname) || !is_text(parsed$hostname)) {
stop(error_stem, " (Can't parse hostname.) ", error_stub)
} else if (!length(parsed$path) || !is_text(parsed$path)) {
stop(error_stem, " (Can't parse path.) ", error_stub)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.