diff --git a/DESCRIPTION b/DESCRIPTION index ba038f1..4ea26cb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,7 +5,7 @@ Authors@R: c(person( family = "Hufkens", given = "Koen", email = "koen.hufkens@gmail.com", - 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; ) diff --git a/NEWS.md b/NEWS.md index 6922b5a..189b66a 100644 --- a/NEWS.md +++ b/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 diff --git a/R/wf_request_batch.R b/R/wf_request_batch.R index ba33127..44997f9 100644 --- a/R/wf_request_batch.R +++ b/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 diff --git a/R/zzz.R b/R/zzz.R index 963c1f5..f3a4781 100644 --- a/R/zzz.R +++ b/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) diff --git a/tests/testthat/test_cds_beta.R b/tests/testthat/test_cds_beta.R new file mode 100644 index 0000000..eb6237e --- /dev/null +++ b/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://google.com")) + + # CDS transfer with wrong type + expect_error(wf_transfer(user = "2088", + url = "http://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") + ) + +})