Merge pull request #127 from bluegreen-labs/patch-time-out

patch time out - allow for dynamically setting the retry rate on both single or batch requests. Fixes the ADS checks (logic error in test script), disables the webapi tests - as to be deprecated

.github/workflows/R-CMD-check.yaml

@@ -26,6 +26,9 @@ jobs:
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      ADS: ${{secrets.ADS}}
+      CDS: ${{secrets.CDS}}
+      WEBAPI: ${{secrets.WEBAPI}}
       R_KEEP_PKG_SOURCE: yes
 
     steps:

.github/workflows/test-coverage.yaml

@@ -1,53 +1,53 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches:
-      - main
-      - master
+    branches: [main, master]
   pull_request:
-    branches:
-      - main
-      - master
+    branches: [main, master]
 
 name: test-coverage
 
 jobs:
   test-coverage:
-    timeout-minutes: 30
-    runs-on: ubuntu-20.04
+    runs-on: ubuntu-latest
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
       ADS: ${{secrets.ADS}}
       CDS: ${{secrets.CDS}}
       WEBAPI: ${{secrets.WEBAPI}}
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
+
       - uses: r-lib/actions/setup-r@v2
-      - uses: r-lib/actions/setup-pandoc@v2
+        with:
+          use-public-rspm: true
 
-      - name: Query dependencies
-        run: |
-          install.packages('remotes')
-          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
-          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
-        shell: Rscript {0}
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr
+          needs: coverage
 
-      - name: Install system dependencies
-        if: runner.os == 'Linux'
+      - name: Test coverage
         run: |
-          while read -r cmd
-          do
-            eval sudo $cmd
-          done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))')
-          sudo apt-get install libgdal-dev libproj-dev libgeos-dev libudunits2-dev netcdf-bin libsodium-dev libsodium23
+          covr::codecov(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package")
+          )
+        shell: Rscript {0}
 
-      - name: Install dependencies
+      - name: Show testthat output
+        if: always()
         run: |
-          install.packages(c("remotes"))
-          remotes::install_deps(dependencies = TRUE)
-          remotes::install_cran("covr")
-        shell: Rscript {0}
+          ## --------------------------------------------------------------------
+          find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
 
-      - name: Test coverage
-        run: covr::codecov()
-        shell: Rscript {0}
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v4
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

.gitignore

@@ -5,3 +5,4 @@
 .Ruserdata
 inst/doc
 docs/
+CRAN-SUBMISSION

DESCRIPTION

@@ -41,10 +41,11 @@ Imports:
     uuid
 License: AGPL-3
 ByteCompile: true
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
 Suggests:
     rmarkdown,
     covr,
+    xml2,
     testthat,
     terra,
     maps,

NAMESPACE

@@ -12,6 +12,7 @@ export(wf_services)
 export(wf_set_key)
 export(wf_transfer)
 export(wf_user_info)
+import(uuid)
 importFrom(R6,R6Class)
 importFrom(memoise,memoise)
 importFrom(utils,browseURL)

NEWS.md

@@ -1,6 +1,7 @@
 # ecmwfr 1.5.1
 
 * Logic patch for 202 http error on long runs
+* dynamic retry polling to avoid API rate limiting (default = 30s)
 
 # ecmwfr 1.5.0
 

R/service-ads.R

@@ -34,8 +34,7 @@ ads_service <- R6::R6Class("ecmwfr_ads", inherit = cds_service,
 
       # grab content, to look at the status
       ct <- httr::content(response)
-
-      ct$code <- 202
+      ct$code <- httr::status_code(response)
 
       # some verbose feedback
       if (private$verbose) {
@@ -46,7 +45,6 @@ ads_service <- R6::R6Class("ecmwfr_ads", inherit = cds_service,
       private$status <- "submitted"
       private$code <- ct$code
       private$name <- ct$request_id
-      private$retry <- 5
       private$next_retry <- Sys.time() + private$retry
       private$url <- wf_server(id = ct$request_id, service = "ads")
       return(self)

R/service-cds.R

@@ -29,9 +29,9 @@ cds_service <- R6::R6Class("ecmwfr_cds",
       }
 
       # grab content, to look at the status
+      # and code
       ct <- httr::content(response)
-
-      ct$code <- 202
+      ct$code <- httr::status_code(response)
 
       # some verbose feedback
       if (private$verbose) {
@@ -42,7 +42,6 @@ cds_service <- R6::R6Class("ecmwfr_cds",
       private$status <- "submitted"
       private$code <- ct$code
       private$name <- ct$request_id
-      private$retry <- 5
       private$next_retry <- Sys.time() + private$retry
       private$url <- wf_server(id = ct$request_id, service = "cds")
       return(self)
@@ -66,6 +65,7 @@ cds_service <- R6::R6Class("ecmwfr_cds",
 
       key <- wf_get_key(user = private$user, service = private$service)
 
+      # set retry time
       retry_in <- as.numeric(private$next_retry) - as.numeric(Sys.time())
 
       if (retry_in > 0) {
@@ -91,6 +91,19 @@ cds_service <- R6::R6Class("ecmwfr_cds",
       ct <- httr::content(response)
       private$status <- ct$state
 
+      # trap general http error most likely
+      # will fail on spamming the service too fast
+      # with a high retry rate
+      if (httr::http_error(response)) {
+        stop(paste0(
+          httr::content(response),
+          "--- check your retry rate!"),
+          call. = FALSE
+        )
+      }
+
+      # checks the status of the true download, not the http status
+      # of the call itself
       if (private$status != "completed" || is.null(private$status)) {
         private$code <- 202
         private$file_url <- NA # just ot be on the safe side

R/service.R

@@ -3,11 +3,13 @@ service <- R6::R6Class("ecmwfr_service", cloneable = FALSE,
     initialize = function(request,
                           user,
                           url,
+                          retry,
                           path = tempdir(),
                           verbose = TRUE) {
       private$user <- user
       private$request <- request
       private$path <- path
+      private$retry <- retry
       private$file <- file.path(path, request$target)
       private$verbose <- verbose
       private$url <- url

R/wf_request.R

@@ -27,6 +27,8 @@
 #' @param path path were to store the downloaded data
 #' @param time_out how long to wait on a download to start (default =
 #' \code{3*3600} seconds).
+#' @param retry polling frequency of submitted request for downloading (default =
+#' \code{30} seconds).
 #' @param transfer logical, download data TRUE or FALSE (default = TRUE)
 #' @param request nested list with query parameters following the layout
 #' as specified on the ECMWF APIs page
@@ -76,6 +78,7 @@ wf_request <- function(
     transfer = TRUE,
     path = tempdir(),
     time_out = 3600,
+    retry = 30,
     job_name,
     verbose = TRUE
 ) {
@@ -161,6 +164,7 @@ wf_request <- function(
     request = request,
     user = service_info$user,
     url = service_info$url,
+    retry = retry,
     path = path
     )
 

R/wf_request_batch.R

@@ -3,6 +3,8 @@
 #' to the service. Most ECMWF services are limited to 20 concurrent requests
 #' (default = 2).
 #' @param total_timeout overall timeout limit for all the requests in seconds.
+#' @param retry polling frequency of submitted request for downloading (default =
+#' \code{30} seconds).
 #' @importFrom R6 R6Class
 #'
 #' @rdname wf_request
@@ -13,6 +15,7 @@ wf_request_batch <- function(
     user,
     path = tempdir(),
     time_out = 3600,
+    retry = 5,
     total_timeout = length(request_list)*time_out/workers
 ) {
 
@@ -53,7 +56,9 @@ wf_request_batch <- function(
           queue[[1]],
           user = user[1],
           time_out = time_out[1],
-          path = path[1], transfer = FALSE
+          retry = retry,
+          path = path[1],
+          transfer = FALSE
           )
         queue <- queue[-1]
         user <- user[-1]

tests/testthat/test_ads.R

@@ -62,7 +62,7 @@ test_that("Could the login be set? Fails if not",{
   skip_on_cran()
 
   # check retrieval
-  expect_true(login_check)
+  expect_true(!login_check)
 })
 
 #----- formal checks ----

tests/testthat/test_cds.R

@@ -6,8 +6,6 @@ if(!("ecmwfr" %in% keyring::keyring_list()$keyring)){
   keyring::keyring_create("ecmwfr", password = "test")
 }
 
-login_check <- FALSE
-
 # check if on github
 ON_GIT <- ifelse(
   Sys.getenv("GITHUB_ACTION") == "",
@@ -281,8 +279,10 @@ test_that("batch request tests", {
       "target"         = paste0(y, "-era5-demo.nc"))
   })
 
-  expect_output(wf_request_batch(
+  expect_output(
+    wf_request_batch(
     requests,
+    retry = 5,
     user = "2088")
     )
 

tests/testthat/test_webapi.r

@@ -16,6 +16,9 @@ ON_GIT <- ifelse(
   TRUE
 )
 
+# force to skip webapi checks
+ON_GIT <- TRUE
+
 # format request (see below)
 my_request <- list(
   stream = "oper",