New cds api release - adding url

DESCRIPTION

@@ -5,7 +5,7 @@ Authors@R: c(person(
  family = "Hufkens",
  given = "Koen",
  email = "[email protected]",
- role = c("aut", "cre"),
+ role = c("aut", "cre", "cph"),
  comment = c(ORCID = "0000-0002-5070-8109")),
  person(
  family = "Stauffer",
@@ -20,7 +20,7 @@ Authors@R: c(person(
  role = c("ctb"),
  comment = c(ORCID = "0000-0002-7742-9230")),
  person(given = "BlueGreen Labs",
- role = c("cph", "fnd"))
+ role = c("fnd"))
  )
 Description: Programmatic interface to the European Centre for Medium-Range
  Weather Forecasts dataset web services (ECMWF; <https://www.ecmwf.int/>)

NEWS.md

@@ -2,6 +2,7 @@
 
 * Logic patch for 202 http error on long runs
 * dynamic retry polling to avoid API rate limiting (default = 30s)
+* adding CDS beta url (new service)
 
 # ecmwfr 1.5.0
 

R/wf_request_batch.R

@@ -48,6 +48,11 @@ wf_request_batch <- function(
  while (length(done) < length(request_list) & Sys.time() < timeout_time) {
  for (w in seq_along(slots)) {
 
+ # wait before submitting a call
+ # set to the same value is the
+ # retry rate
+ Sys.sleep(retry)
+
  # If a slot is free and there's a queue,
  # assign to it the next pending request,
  # remove that request from the queue

R/zzz.R

@@ -14,14 +14,15 @@
 # \code{type == "cds"}).
 #
 # @author Koen Kufkens
-wf_server <- function(id, service = "webapi") {
+wf_server <- function(id, service = "cds") {
 
  # match arguments, if not stop
- service <- match.arg(service, c("webapi", "cds", "ads"))
+ service <- match.arg(service, c("webapi", "cds", "cds-beta", "ads"))
 
  # set base urls
  webapi_url <- "https://api.ecmwf.int/v1"
  cds_url <- "https://cds.climate.copernicus.eu/api/v2"
+ cds_beta_url <- "https://cds-beta.climate.copernicus.eu/api"
  ads_url <- "https://ads.atmosphere.copernicus.eu/api/v2"
 
  # return url depending on service or id
@@ -37,6 +38,12 @@ wf_server <- function(id, service = "webapi") {
  } else {
  return(file.path(ads_url, "tasks", id))
  }
+ } else if (service == "cds-beta") {
+ if (missing(id)) {
+ return(cds_beta_url)
+ } else {
+ return(file.path(cds_beta_url, "tasks", id))
+ }
  } else {
  if (missing(id)) {
  return(cds_url)

tests/testthat/test_cds_beta.R

@@ -0,0 +1,299 @@
+# set options
+options(keyring_backend="file")
+
+# spoof keyring
+if(!("ecmwfr" %in% keyring::keyring_list()$keyring)){
+ keyring::keyring_create("ecmwfr", password = "test")
+}
+
+# check if on github
+ON_GIT <- ifelse(
+ Sys.getenv("GITHUB_ACTION") == "",
+ FALSE,
+ TRUE
+)
+
+# ignore SSL (server has SSL issues)
+#httr::set_config(httr::config(ssl_verifypeer = 0L))
+
+# format request (see below)
+cds_request <- list(
+ "dataset_short_name" = "reanalysis-era5-pressure-levels",
+ "product_type" = "reanalysis",
+ "format" = "netcdf",
+ "variable" = "temperature",
+ "pressure_level" = "850",
+ "year" = "2018",
+ "month" = "04",
+ "day" = "04",
+ "time" = "00:00",
+ "area" = "50/9/51/10",
+ "format" = "netcdf",
+ "target" = "era5-demo.nc"
+ )
+
+cds_request_faulty <- list(
+ "dataset_short_name" = "reanalysis-era5-preure-levels",
+ "product_type" = "reanalysis",
+ "format" = "netcdf",
+ "variable" = "temperature",
+ "pressure_level" = "850",
+ "year" = "2018",
+ "month" = "04",
+ "day" = "04",
+ "time" = "00:00",
+ "area" = "50/9/51/10",
+ "format" = "netcdf",
+ "target" = "era5-demo.nc"
+ )
+
+# is the server reachable
+server_check <- ecmwfr:::ecmwf_running(ecmwfr:::wf_server(service = "cds-beta"))
+
+# if the server is reachable, try to set login
+# if not set login check to TRUE as well
+if(server_check & ON_GIT){
+ user <- try(
+ ecmwfr::wf_set_key(
+ user = "2088",
+ key = Sys.getenv("CDS"),
+ service = "cds-beta")
+ )
+
+ # set login check to TRUE so skipped if
+ # the user is not created
+ login_check <- inherits(user, "try-error")
+} else {
+ login_check <- TRUE
+}
+
+#----- formal checks ----
+test_that("set key", {
+ skip_on_cran()
+ skip_if(login_check)
+ expect_message(wf_set_key(user = "2088",
+ Sys.getenv("CDS"),
+ service = "cds-beta"))
+})
+
+test_that("cds datasets returns data.frame or list", {
+ skip_on_cran()
+ skip_if(login_check)
+ expect_true(inherits(wf_datasets(user = "2088",
+ service = "cds-beta",
+ simplify = TRUE), "data.frame"))
+ expect_true(inherits(wf_datasets(user = "2088",
+ service = "cds-beta",
+ simplify = FALSE), "list"))
+})
+
+# Testing the cds request function
+test_that("cds request", {
+ skip_on_cran()
+ skip_if(login_check)
+
+ # ok transfer
+ expect_message(
+ wf_request(
+ user = "2088",
+ request = cds_request,
+ transfer = TRUE
+ )
+ )
+
+ # timeout trigger
+ expect_message(
+ wf_request(
+ user = "2088",
+ request = cds_request,
+ time_out = -1,
+ transfer = TRUE
+ )
+ )
+
+ # job test (can't run headless)
+ expect_error(
+ wf_request(
+ user = "2088",
+ request = cds_request,
+ transfer = TRUE,
+ job_name = "jobtest"
+ )
+ )
+
+ # faulty request
+ expect_error(
+ wf_request(
+ user = "2088",
+ request = cds_request_faulty
+ )
+ )
+
+ # wrong request
+ expect_error(
+ wf_request(
+ user = "2088",
+ request = "xyz",
+ transfer = TRUE
+ )
+ )
+
+ # missing request
+ expect_error(wf_request(
+ user = "2088",
+ transfer = TRUE
+ )
+ )
+
+ # missing user
+ expect_error(wf_request(
+ request = cds_request,
+ transfer = TRUE
+ )
+ )
+
+ r <- wf_request(
+ user = "2088",
+ request = cds_request,
+ transfer = FALSE
+ )
+
+ # is R6 class
+ expect_true(inherits(r, "R6"))
+ r$delete() # cleanup
+
+})
+
+
+# # Expecting error if required arguments are not set:
+test_that("required arguments missing for cds_* functions", {
+ skip_on_cran()
+ skip_if(login_check)
+
+ # submit request
+ r <- wf_request(
+ user = "2088",
+ request = cds_request,
+ transfer = FALSE
+ )
+
+ # CDS dataset (requires at least 'user')
+ expect_error(wf_dataset())
+ expect_output(str(wf_datasets(user = "2088", service = "cds-beta")))
+
+ # CDS productinfo (requires at least 'user' and 'dataset')
+ expect_error(wf_product_info())
+ expect_error(wf_product_info(
+ user = "2088",
+ service = "cds-beta",
+ dataset = "foo"
+ )
+ )
+
+ # CDS productinfo: product name which is not available
+ expect_output(str(wf_product_info(
+ user = "2088",
+ service = "cds-beta",
+ dataset = "satellite-methane"
+ )
+ )
+ )
+
+ # check transfer routine
+ expect_output(
+ wf_transfer(
+ user = "2088",
+ service = "cds-beta",
+ url = r$get_url()
+ )
+ )
+
+ # Delete file, check status
+ r$delete()
+ expect_equal(
+ r$get_status(), "deleted"
+ )
+
+ # CDS tranfer (forwarded to wf_transfer, requires at least
+ # 'user' and 'url)
+ expect_error(wf_transfer())
+ expect_error(wf_transfer(user = "2088",
+ service = "cds-beta",
+ url = "http:https://google.com"))
+
+ # CDS transfer with wrong type
+ expect_error(wf_transfer(user = "2088",
+ url = "http:https://google.com",
+ service = "foo"))
+
+ # check product listing
+ expect_output(str(wf_product_info("reanalysis-era5-single-levels",
+ service = "cds-beta",
+ user = NULL,
+ simplify = FALSE)))
+
+ expect_output(str(wf_product_info("reanalysis-era5-single-levels",
+ service = "cds-beta",
+ user = NULL,
+ simplify = FALSE)))
+})
+
+# check delete routine CDS (fails)
+test_that("delete request", {
+ skip_on_cran()
+ skip_if(login_check)
+ expect_warning(
+ wf_delete(user = "2088",
+ service = "cds-beta",
+ url = "50340909as"))
+})
+
+# CDS product info
+test_that("check product info",{
+ skip_on_cran()
+ skip_if(login_check)
+ expect_output(
+ str(wf_product_info("reanalysis-era5-single-levels",
+ service = "cds-beta",
+ user = NULL)))
+})
+
+test_that("batch request tests", {
+ skip_on_cran()
+ skip_if(login_check)
+
+ years <- c(2017,2018)
+ requests <- lapply(years, function(y) {
+ list(
+ "dataset_short_name" = "reanalysis-era5-pressure-levels",
+ "product_type" = "reanalysis",
+ "format" = "netcdf",
+ "variable" = "temperature",
+ "pressure_level" = "850",
+ "year" = y,
+ "month" = "05",
+ "day" = "04",
+ "time" = "00:00",
+ "area" = "50/9/51/10",
+ "format" = "netcdf",
+ "target" = paste0(y, "-era5-demo.nc"))
+ })
+
+ expect_output(
+ wf_request_batch(
+ requests,
+ retry = 5,
+ user = "2088")
+ )
+
+ requests_dup <- lapply(requests, function(r) {
+ r$target <- "era5.nc"
+ r
+ })
+
+ expect_error(wf_request_batch(
+ requests_dup,
+ user = "2088")
+ )
+
+})