Make sure to always fail gracefully if server not accessible
See CRAN policy:
Packages which use Internet resources should fail gracefully with an informative message
if the resource is not available or has changed (and not give a check warning nor error).
at https://cran.r-project.org/web/packages/policies.html
Change-Id: I0c346c75786b8f5392694337254d6f19f91d7caf
diff --git a/DESCRIPTION b/DESCRIPTION
index 257b420..a0e335c 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -45,6 +45,7 @@
keyring,
utils,
httr,
+ curl,
methods,
PTXQC,
purrr,
diff --git a/NAMESPACE b/NAMESPACE
index 9420cc0..bb89cd8 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -54,6 +54,7 @@
importFrom(PTXQC,lcpCount)
importFrom(PTXQC,lcsCount)
importFrom(broom,tidy)
+importFrom(curl,has_internet)
importFrom(dplyr,.data)
importFrom(dplyr,anti_join)
importFrom(dplyr,arrange)
diff --git a/R/KorAPConnection.R b/R/KorAPConnection.R
index e4a1ed2..61e0614 100644
--- a/R/KorAPConnection.R
+++ b/R/KorAPConnection.R
@@ -2,6 +2,7 @@
# Use setClassUnion to define the unholy NULL-data union as a virtual class.
################################################################################
setClassUnion("characterOrNULL", c("character", "NULL"))
+setClassUnion("listOrNULL", c("list", "NULL"))
#' Class KorAPConnection
#'
@@ -12,7 +13,7 @@
#' @import utils
#' @import methods
#' @export
-KorAPConnection <- setClass("KorAPConnection", slots=c(KorAPUrl="character", apiVersion="character", indexRevision="characterOrNULL", apiUrl="character", accessToken="characterOrNULL", userAgent="character", timeout="numeric", verbose="logical", cache="logical"))
+KorAPConnection <- setClass("KorAPConnection", slots=c(KorAPUrl="character", apiVersion="character", indexRevision="characterOrNULL", apiUrl="character", accessToken="characterOrNULL", userAgent="character", timeout="numeric", verbose="logical", cache="logical", welcome="listOrNULL"))
#' @param .Object KorAPConnection object
#' @param KorAPUrl the URL of the KorAP server instance you want to access.
@@ -80,9 +81,11 @@
.Object@timeout = timeout
.Object@verbose = verbose
.Object@cache = cache
- welcome <- apiCall(.Object, .Object@apiUrl, json = FALSE, cache = FALSE, getHeaders = TRUE)
- message(welcome[[2]])
- .Object@indexRevision <- welcome[[1]][["x-index-revision"]]
+ .Object@welcome = apiCall(.Object, .Object@apiUrl, json = FALSE, cache = FALSE, getHeaders = TRUE)
+ if (!is.null(.Object@welcome)) {
+ message(.Object@welcome[[2]])
+ }
+ .Object@indexRevision <- .Object@welcome[[1]][["x-index-revision"]]
.Object
})
@@ -175,8 +178,9 @@
#' @param json logical that determines if json result is expected
#' @param getHeaders logical that determines if headers and content should be returned (as a list)
#' @importFrom jsonlite fromJSON
+#' @importFrom curl has_internet
#' @export
-setMethod("apiCall", "KorAPConnection", function(kco, url, json = TRUE, getHeaders = FALSE, cache = kco@cache) {
+setMethod("apiCall", "KorAPConnection", function(kco, url, json = TRUE, getHeaders = FALSE, cache = kco@cache, timeout=kco@timeout) {
result <- ""
if (cache) {
result <- R.cache::loadCache(dir=KorAPCacheSubDir(), key=list(url, kco@accessToken, kco@indexRevision))
@@ -186,32 +190,60 @@
return(result)
}
}
+
+ # From https://community.rstudio.com/t/internet-resources-should-fail-gracefully/49199/11
+ # Thanks to kvasilopoulos
+ try_GET <- function(x, ...) {
+ tryCatch(
+ GET(url = x, timeout(timeout), ...),
+ error = function(e) conditionMessage(e),
+ warning = function(w) conditionMessage(w)
+ )
+ }
+ is_response <- function(x) {
+ class(x) == "response"
+ }
+
+ # First check internet connection
+ if (!curl::has_internet()) {
+ message("No internet connection.")
+ return(invisible(NULL))
+ }
+
if (!is.null(kco@accessToken))
- resp <- GET(url, user_agent(kco@userAgent), timeout(kco@timeout), add_headers(Authorization = paste("Bearer", kco@accessToken)))
+ resp <- try_GET(url, user_agent(kco@userAgent), timeout(timeout), add_headers(Authorization = paste("Bearer", kco@accessToken)))
else
- resp <- GET(url, user_agent(kco@userAgent), timeout(kco@timeout))
+ resp <- try_GET(url, user_agent(kco@userAgent), timeout(timeout))
+
+ if (!is_response(resp)) {
+ message(resp)
+ return(invisible(NULL))
+ }
if (json || status_code(resp) != 200) {
if (json && !http_type(resp) %in% c("application/json", "application/ld+json")) {
- stop("API did not return json", call. = FALSE)
+ # message("API did not return json")
+ return(invisible(NULL))
}
result <- jsonlite::fromJSON(content(resp, "text", encoding = "UTF-8"))
if (!is.null(result$warnings)) {
- message <- if (nrow(result$warnings) > 1)
+ msg <- if (nrow(result$warnings) > 1)
sapply(result$warnings, function(warning) paste(sprintf("%s: %s", warning[1], warning[2]), sep="\n"))
else
sprintf("%s: %s", result$warnings[1], result$warnings[2])
- warning(message, call. = FALSE)
+ message(msg)
}
}
if (status_code(resp) != 200) {
if (kco@verbose) {
cat("\n")
}
- message <- sprintf("%s KorAP API request failed", status_code(resp))
+ msg <- sprintf("%s KorAP API request failed", status_code(resp))
if (!is.null(result$errors)) {
- message <- sprintf("%s - %s %s", message, result$errors[1], result$errors[2])
+ errormsg <- unlist(result$errors)
+ msg <- sprintf("%s: %s %s", msg, errormsg[5], errormsg[2])
}
- stop(message, call. = FALSE)
+ message(msg)
+ return(invisible(NULL))
}
if (!json) {
result <- content(resp, "text", encoding = "UTF-8")
diff --git a/R/KorAPCorpusStats.R b/R/KorAPCorpusStats.R
index 7d299ca..68e1103 100644
--- a/R/KorAPCorpusStats.R
+++ b/R/KorAPCorpusStats.R
@@ -47,6 +47,9 @@
URLencode(enc2utf8(vc), reserved = TRUE))
log.info(verbose, "Getting size of virtual corpus \"", vc, "\"", sep = "")
res <- apiCall(kco, url)
+ if(is.null(res)) {
+ res <- data.frame(documents=NA, tokens=NA, sentences=NA, paragraphs=NA)
+ }
log.info(verbose, ": ", res$tokens, " tokens\n")
if (as.df)
data.frame(vc = vc, res, stringsAsFactors = FALSE)
diff --git a/R/KorAPQuery.R b/R/KorAPQuery.R
index 9bab575..eb2afbd 100644
--- a/R/KorAPQuery.R
+++ b/R/KorAPQuery.R
@@ -188,15 +188,22 @@
log.info(verbose, "Searching \"", query, "\" in \"", vc, "\"", sep =
"")
res = apiCall(kco, paste0(requestUrl, '&count=0'))
- log.info(verbose, ": ", res$meta$totalResults, " hits")
- if(!is.null(res$meta$cached))
- log.info(verbose, " [cached]\n")
- else
- log.info(verbose, ", took ", res$meta$benchmark, "\n", sep = "")
+ if (is.null(res)) {
+ log.info(verbose, " [failed]\n")
+ message("API call failed.")
+ totalResults <- 0
+ } else {
+ totalResults <-res$meta$totalResults
+ log.info(verbose, ": ", totalResults, " hits")
+ if(!is.null(res$meta$cached))
+ log.info(verbose, " [cached]\n")
+ else
+ log.info(verbose, ", took ", res$meta$benchmark, "\n", sep = "")
+ }
if (as.df)
data.frame(
query = query,
- totalResults = res$meta$totalResults,
+ totalResults = totalResults,
vc = vc,
webUIRequestUrl = webUIRequestUrl,
stringsAsFactors = FALSE
@@ -208,11 +215,11 @@
fields = fields,
requestUrl = requestUrl,
request = request,
- totalResults = res$meta$totalResults,
+ totalResults = totalResults,
vc = vc,
apiResponse = res,
webUIRequestUrl = webUIRequestUrl,
- hasMoreMatches = (res$meta$totalResults > 0),
+ hasMoreMatches = (totalResults > 0),
)
}
})
diff --git a/R/ci.R b/R/ci.R
index a0c04f7..19f8615 100644
--- a/R/ci.R
+++ b/R/ci.R
@@ -40,8 +40,12 @@
x <- enquo(x)
N <- enquo(N)
nas <- df %>%
- dplyr::filter(total <= 0) %>%
+ dplyr::filter(is.na(total) | total <= 0) %>%
mutate(f = NA, conf.low = NA, conf.high = NA)
+
+ if (nrow(df) == nrow(nas))
+ return(nas)
+
df %>%
dplyr::filter(total > 0) %>%
rowwise %>%
diff --git a/man/KorAPConnection-class.Rd b/man/KorAPConnection-class.Rd
index 75a165e..13ebf7e 100644
--- a/man/KorAPConnection-class.Rd
+++ b/man/KorAPConnection-class.Rd
@@ -32,7 +32,14 @@
\S4method{clearAccessToken}{KorAPConnection}(kco)
-\S4method{apiCall}{KorAPConnection}(kco, url, json = TRUE, getHeaders = FALSE, cache = kco@cache)
+\S4method{apiCall}{KorAPConnection}(
+ kco,
+ url,
+ json = TRUE,
+ getHeaders = FALSE,
+ cache = kco@cache,
+ timeout = kco@timeout
+)
\S4method{clearCache}{KorAPConnection}(kco)
diff --git a/tests/testthat/test-KorAPConnection.R b/tests/testthat/test-KorAPConnection.R
index c96805d..9eea61f 100644
--- a/tests/testthat/test-KorAPConnection.R
+++ b/tests/testthat/test-KorAPConnection.R
@@ -1,5 +1,14 @@
+test_that("KorAPConnection fails gracefully on unresolvable host", {
+ expect_message(new("KorAPConnection", apiUrl="http://xxx.asdhsahdsadhvgas.org"), "No internet|Could not resolve")
+})
+
+test_that("KorAPConnection fails gracefully on timeout", {
+ expect_message(new("KorAPConnection", apiUrl="http://httpbin.org/delay/3", timeout = 1), "No internet|Timeout")
+})
+
test_that("KorAPConnection is printable", {
- kco <- new("KorAPConnection")
+ kco <- new("KorAPConnection", timeout = 10)
+ skip_if(is.null(kco@welcome))
expect_error(print(kco), NA)
})
@@ -7,22 +16,23 @@
expect_message(new("KorAPConnection"), "KorAP")
})
-test_that("Opening KorAPConnection with invalid apiToken fails", {
- expect_error(new("KorAPConnection", accessToken="test token"),
- "401")
+test_that("Opening KorAPConnection with invalid apiToken fails gracefully", {
+ expect_message(new("KorAPConnection", accessToken="test token", timeout = 10),
+ "401|Timeout")
})
test_that("Persisting null apiToken fails", {
- kco <- new("KorAPConnection")
+ kco <- new("KorAPConnection", timeout = 10)
skip_if_not(is.null(kco@accessToken))
+ skip_if(is.null(kco@welcome))
expect_error(persistAccessToken(kco),
".*not supplied any access token.*",
perl = TRUE)
})
test_that("Opening KorAPConnection with KorAPUrl works", {
- kco <- new("KorAPConnection", KorAPUrl="https://korap.ids-mannheim.de")
+ kco <- new("KorAPConnection", KorAPUrl="https://korap.ids-mannheim.de", timeout = 1)
expect_equal(kco@apiUrl, paste0("https://korap.ids-mannheim.de/api/", kco@apiVersion, "/"))
- kco <- new("KorAPConnection", KorAPUrl="https://korap.ids-mannheim.de/")
+ kco <- new("KorAPConnection", KorAPUrl="https://korap.ids-mannheim.de/", timeout = 1)
expect_equal(kco@apiUrl, paste0("https://korap.ids-mannheim.de/api/", kco@apiVersion, "/"))
})