From ebef0761ac101016cf806eded98125b10bf64165 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 15 Oct 2024 16:16:43 -0500 Subject: [PATCH 1/7] First pass at making a retry for ERROR: INCOMPLETE return --- R/getWebServiceData.R | 96 +++++++++++++++++++++++++------------------ 1 file changed, 57 insertions(+), 39 deletions(-) diff --git a/R/getWebServiceData.R b/R/getWebServiceData.R index ccdd9489..9c53206a 100644 --- a/R/getWebServiceData.R +++ b/R/getWebServiceData.R @@ -25,49 +25,31 @@ getWebServiceData <- function(obs_url, ...) { returnedList <- retryGetOrPost(obs_url, ...) - if (httr::status_code(returnedList) == 400) { - if (httr::has_content(returnedList)) { - response400 <- httr::content(returnedList, type = "text", encoding = "UTF-8") - statusReport <- xml2::xml_text(xml2::xml_child(xml2::read_xml(response400), 2)) # making assumption that - body is second node - statusMsg <- gsub(pattern = ", server=.*", replacement = "", x = statusReport) - message(statusMsg) - } else { - httr::message_for_status(returnedList) - warning_message <- httr::headers(returnedList) - if ("warning" %in% names(warning_message)) { - warning_message <- warning_message$warning - message(warning_message) - } - } - return(invisible(NULL)) - } else if (httr::status_code(returnedList) != 200) { - message("For: ", obs_url, "\n") - httr::message_for_status(returnedList) - return(invisible(NULL)) - } else { + good <- check_non_200s(returnedList) + + return_readLines <- c("text/html", "text/html; charset=UTF-8") + return_raw <- c("application/zip", + "application/zip;charset=UTF-8", + "application/vnd.geo+json;charset=UTF-8") + return_content <- c("text/tab-separated-values;charset=UTF-8", + "text/csv;charset=UTF-8" ) + + if(good){ headerInfo <- httr::headers(returnedList) - if (!"content-type" %in% names(headerInfo)) { - message("Unknown content, returning NULL") - return(invisible(NULL)) - } - - if (headerInfo$`content-type` %in% c( - "text/tab-separated-values;charset=UTF-8", - "text/csv;charset=UTF-8" - )) { + if (headerInfo$`content-type` %in% return_content) { returnedDoc <- httr::content(returnedList, type = "text", encoding = "UTF-8") - } else if (headerInfo$`content-type` %in% - c( - "application/zip", - "application/zip;charset=UTF-8", - "application/vnd.geo+json;charset=UTF-8" - )) { + if (all(grepl("ERROR: INCOMPLETE DATA", returnedDoc))) { + + returnedList <- retryGetOrPost(obs_url, ...) + good <- check_non_200s(returnedList) + if(good){ + returnedDoc <- httr::content(returnedList, type = "text", encoding = "UTF-8") + } + } + } else if (headerInfo$`content-type` %in% return_raw) { returnedDoc <- returnedList - } else if (headerInfo$`content-type` %in% c( - "text/html", - "text/html; charset=UTF-8" - )) { + } else if (headerInfo$`content-type` %in% return_readLines) { txt <- readLines(returnedList$content) message(txt) return(txt) @@ -94,6 +76,42 @@ getWebServiceData <- function(obs_url, ...) { } } +check_non_200s <- function(returnedList){ + + status <- httr::status_code(returnedList) + if (status == 400) { + if (httr::has_content(returnedList)) { + response400 <- httr::content(returnedList, type = "text", encoding = "UTF-8") + statusReport <- xml2::xml_text(xml2::xml_child(xml2::read_xml(response400), 2)) # making assumption that - body is second node + statusMsg <- gsub(pattern = ", server=.*", replacement = "", x = statusReport) + message(statusMsg) + } else { + httr::message_for_status(returnedList) + warning_message <- httr::headers(returnedList) + if ("warning" %in% names(warning_message)) { + warning_message <- warning_message$warning + message(warning_message) + } + } + return(FALSE) + } else if (status != 200) { + message("For: ", obs_url, "\n") + httr::message_for_status(returnedList) + return(FALSE) + + } else { + headerInfo <- httr::headers(returnedList) + + if (!"content-type" %in% names(headerInfo)) { + message("Unknown content, returning NULL") + return(FALSE) + } + return(TRUE) + } + + +} + #' Create user agent #' #' @keywords internal From 7f8b360c1310fb77b5ee63d75eb1228ac7c76f6a Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Wed, 16 Oct 2024 08:29:35 -0500 Subject: [PATCH 2/7] still work in progress --- R/getWebServiceData.R | 29 +++++++++++++++++++++-------- R/readWQPdata.R | 4 ++++ tests/testthat/tests_general.R | 19 +++++++++++-------- 3 files changed, 36 insertions(+), 16 deletions(-) diff --git a/R/getWebServiceData.R b/R/getWebServiceData.R index 9c53206a..2e55e637 100644 --- a/R/getWebServiceData.R +++ b/R/getWebServiceData.R @@ -32,21 +32,33 @@ getWebServiceData <- function(obs_url, ...) { "application/zip;charset=UTF-8", "application/vnd.geo+json;charset=UTF-8") return_content <- c("text/tab-separated-values;charset=UTF-8", - "text/csv;charset=UTF-8" ) + "text/csv;charset=UTF-8", + "text/plain") if(good){ headerInfo <- httr::headers(returnedList) if (headerInfo$`content-type` %in% return_content) { returnedDoc <- httr::content(returnedList, type = "text", encoding = "UTF-8") + trys <- 1 if (all(grepl("ERROR: INCOMPLETE DATA", returnedDoc))) { - - returnedList <- retryGetOrPost(obs_url, ...) - good <- check_non_200s(returnedList) - if(good){ - returnedDoc <- httr::content(returnedList, type = "text", encoding = "UTF-8") - } + + while(trys <= 3){ + message("Trying again!") + Sys.sleep(5) + returnedList <- retryGetOrPost(obs_url, pause_base = 20) + good <- check_non_200s(returnedList) + if(good){ + returnedDoc <- httr::content(returnedList, type = "text", encoding = "UTF-8") + } + if (all(grepl("ERROR: INCOMPLETE DATA", returnedDoc))) { + trys <- trys + 1 + } else { + trys <- 100 + } + } } + } else if (headerInfo$`content-type` %in% return_raw) { returnedDoc <- returnedList } else if (headerInfo$`content-type` %in% return_readLines) { @@ -73,6 +85,8 @@ getWebServiceData <- function(obs_url, ...) { attr(returnedDoc, "headerInfo") <- headerInfo return(returnedDoc) + } else { + return(NULL) } } @@ -95,7 +109,6 @@ check_non_200s <- function(returnedList){ } return(FALSE) } else if (status != 200) { - message("For: ", obs_url, "\n") httr::message_for_status(returnedList) return(FALSE) diff --git a/R/readWQPdata.R b/R/readWQPdata.R index d7307723..911f3687 100644 --- a/R/readWQPdata.R +++ b/R/readWQPdata.R @@ -258,6 +258,10 @@ readWQPdata <- function(..., convertType = convertType ) + if(is.null(retval)){ + return(NULL) + } + attr(retval, "legacy") <- legacy if(!legacy){ diff --git a/tests/testthat/tests_general.R b/tests/testthat/tests_general.R index 2ca5913b..9cefda6b 100644 --- a/tests/testthat/tests_general.R +++ b/tests/testthat/tests_general.R @@ -236,15 +236,17 @@ test_that("General WQP retrievals working", { # testing lists: startDate <- as.Date("2023-01-01") - secchi.names <- c( - "Depth, Secchi disk depth", - "Depth, Secchi disk depth (choice list)", - "Secchi Reading Condition (choice list)", - "Water transparency, Secchi disc" - ) + secchi.names <- c("Depth, Secchi disk depth", + "Secchi depth", + "Water transparency, Secchi disc", + "Depth, Secchi disk depth (choice list)", + "Transparency, Secchi tube with disk", + "Secchi Reading Condition (choice list)", + "Depth, Secchi disk visible at bottom (Y/N) (choice list)") + args_2 <- list( "startDateLo" = startDate, - "startDateHi" = "2013-12-31", + "startDateHi" = "2024-01-01", statecode = "WI", characteristicName = secchi.names ) @@ -258,7 +260,8 @@ test_that("General WQP retrievals working", { statecode = "WI", characteristicName = secchi.names ) - + lakeData <- readWQPdata(args_2, ignore_attributes = TRUE) + lakeSites <- whatWQPsites(args_2) expect_type(lakeSites, "list") From 10e851a09c061da56327931f7832dbc794c66750 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Wed, 16 Oct 2024 08:41:51 -0500 Subject: [PATCH 3/7] make the error just be from server --- R/readWQPqw.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/readWQPqw.R b/R/readWQPqw.R index da1f2b31..138440aa 100644 --- a/R/readWQPqw.R +++ b/R/readWQPqw.R @@ -81,6 +81,9 @@ readWQPqw <- function(siteNumbers, } else { retval <- importWQP(url, tz = tz, convertType = convertType) + if(is.null(retval)){ + return(NULL) + } attr(retval, "legacy") <- legacy if(legacy){ From 8e350e66657f49e663a74021a79116671b36aa40 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Wed, 16 Oct 2024 10:21:27 -0500 Subject: [PATCH 4/7] Add fake parameter to get around cache --- R/getWebServiceData.R | 6 +++--- tests/testthat/tests_general.R | 12 ++++++------ 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/R/getWebServiceData.R b/R/getWebServiceData.R index 2e55e637..adde6dab 100644 --- a/R/getWebServiceData.R +++ b/R/getWebServiceData.R @@ -43,10 +43,10 @@ getWebServiceData <- function(obs_url, ...) { trys <- 1 if (all(grepl("ERROR: INCOMPLETE DATA", returnedDoc))) { - while(trys <= 3){ + while(trys <= 5){ message("Trying again!") - Sys.sleep(5) - returnedList <- retryGetOrPost(obs_url, pause_base = 20) + obs_url <- paste0(obs_url, "&try=", trys) + returnedList <- retryGetOrPost(obs_url) good <- check_non_200s(returnedList) if(good){ returnedDoc <- httr::content(returnedList, type = "text", encoding = "UTF-8") diff --git a/tests/testthat/tests_general.R b/tests/testthat/tests_general.R index 9cefda6b..9d421c2d 100644 --- a/tests/testthat/tests_general.R +++ b/tests/testthat/tests_general.R @@ -235,14 +235,14 @@ test_that("General WQP retrievals working", { expect_is(pHData$Activity_StartDateTime, "POSIXct") # testing lists: - startDate <- as.Date("2023-01-01") + startDate <- as.Date("2022-01-01") secchi.names <- c("Depth, Secchi disk depth", "Secchi depth", "Water transparency, Secchi disc", - "Depth, Secchi disk depth (choice list)", - "Transparency, Secchi tube with disk", - "Secchi Reading Condition (choice list)", - "Depth, Secchi disk visible at bottom (Y/N) (choice list)") + "Depth, Secchi disk depth (choice list)") + # "Transparency, Secchi tube with disk", + # "Secchi Reading Condition (choice list)", + # "Depth, Secchi disk visible at bottom (Y/N) (choice list)") args_2 <- list( "startDateLo" = startDate, @@ -261,7 +261,7 @@ test_that("General WQP retrievals working", { characteristicName = secchi.names ) lakeData <- readWQPdata(args_2, ignore_attributes = TRUE) - + expect_true(nrow(lakeData) > 0) lakeSites <- whatWQPsites(args_2) expect_type(lakeSites, "list") From ac6126969288d102cff65749f06a0394c14469ee Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Wed, 16 Oct 2024 11:41:56 -0500 Subject: [PATCH 5/7] Add another site/pcode combo to mix things up. --- tests/testthat/tests_userFriendly_fxns.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/testthat/tests_userFriendly_fxns.R b/tests/testthat/tests_userFriendly_fxns.R index 07c6afa5..55d41650 100644 --- a/tests/testthat/tests_userFriendly_fxns.R +++ b/tests/testthat/tests_userFriendly_fxns.R @@ -146,6 +146,10 @@ test_that("WQP qw tests", { INFO2 <- readWQPqw("WIDNR_WQX-10032762", nameToUse, startDate = "", endDate = "") expect_is(INFO2$Activity_StartDateTime, "POSIXct") + + df <- readWQPqw("USGS-04193500", parameterCd = "00665") + expect_true(nrow(df) > 0) + }) context("readNWISstat tests") From 3a3773f0e930f217fbe23d276d809cab7d6a7168 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Sun, 20 Oct 2024 09:03:53 -0500 Subject: [PATCH 6/7] Retry up to 3 times --- R/getWebServiceData.R | 2 +- tests/testthat/tests_general.R | 2 ++ tests/testthat/tests_userFriendly_fxns.R | 2 ++ 3 files changed, 5 insertions(+), 1 deletion(-) diff --git a/R/getWebServiceData.R b/R/getWebServiceData.R index adde6dab..934eadea 100644 --- a/R/getWebServiceData.R +++ b/R/getWebServiceData.R @@ -43,7 +43,7 @@ getWebServiceData <- function(obs_url, ...) { trys <- 1 if (all(grepl("ERROR: INCOMPLETE DATA", returnedDoc))) { - while(trys <= 5){ + while(trys <= 3){ message("Trying again!") obs_url <- paste0(obs_url, "&try=", trys) returnedList <- retryGetOrPost(obs_url) diff --git a/tests/testthat/tests_general.R b/tests/testthat/tests_general.R index 9d421c2d..5c10c2d8 100644 --- a/tests/testthat/tests_general.R +++ b/tests/testthat/tests_general.R @@ -502,6 +502,8 @@ test_that("internal functions", { }) test_that("profiles", { + + testthat::skip_on_cran() # Data profiles: "Organization Data" org_data <- readWQPdata( statecode = "WI", diff --git a/tests/testthat/tests_userFriendly_fxns.R b/tests/testthat/tests_userFriendly_fxns.R index 55d41650..32de728f 100644 --- a/tests/testthat/tests_userFriendly_fxns.R +++ b/tests/testthat/tests_userFriendly_fxns.R @@ -150,6 +150,8 @@ test_that("WQP qw tests", { df <- readWQPqw("USGS-04193500", parameterCd = "00665") expect_true(nrow(df) > 0) + df2 <- readWQPqw("USGS-05427718", parameterCd = "all") + expect_true(nrow(df2) > 0) }) context("readNWISstat tests") From 743d5c9bc3cbe812ae9c09e030b5f3385f06699e Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Mon, 21 Oct 2024 12:08:08 -0500 Subject: [PATCH 7/7] Trying to make sure there are no internet calls --- tests/testthat/tests_nldi.R | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/tests/testthat/tests_nldi.R b/tests/testthat/tests_nldi.R index 016b7913..1231a753 100644 --- a/tests/testthat/tests_nldi.R +++ b/tests/testthat/tests_nldi.R @@ -29,14 +29,7 @@ test_that("NLDI offerings...", { }) -xx <- findNLDI( - wqp = "TCEQMAIN-10016", - nav = "UM", - find = "nwissite", - distance_km = 2, - no_sf = FALSE, - warn = FALSE -) + test_that("NLDI starting sources...", {