tests/testthat/test_ds.R

In ecmwfr: Interface to 'ECMWF' and 'CDS' Data Web Services

# 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))

cds_request <- list(
  dataset_short_name = "reanalysis-era5-pressure-levels",
  product_type = "reanalysis",
  variable = "geopotential",
  year = "2024",
  month = "03",
  day = "01",
  time = "13:00",
  pressure_level = "1000",
  data_format = "grib",
  area = c(51, 1, 50, 2),
  target = "download.grib"
)

cds_request_faulty <- list(
  dataset_short_name = "reanalysis-era5-prssre-levels",
  product_type = "reanalysis",
  variable = "geopotential",
  year = "2024",
  month = "03",
  day = "01",
  time = "13:00",
  pressure_level = "1000",
  data_format = "grib",
  area = c(51, 1, 50, 2),
  target = "download.grib"
)

# is the server reachable
server_check <- ecmwfr:::ecmwf_running(
    paste0(ecmwfr:::wf_server(service = "cds"),"/catalogue/v1/collections/")
  )

# 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(
        key = Sys.getenv("CDS"))
      )

  # set login check to TRUE so skipped if
  # the user is not created
  login_check <- inherits(user, "try-error")
} else {

  login_check <- TRUE

  # assume local run
  # if(!inherits(wf_get_key(), "try-error")){
  #   Sys.setenv(CDS = wf_get_key())
  #   login_check <- FALSE
  # } else{
  #   login_check <- TRUE
  # }
}

#----- formal checks ----
test_that("set key", {
  skip_on_cran()
  skip_if(login_check)
  expect_message(wf_set_key(Sys.getenv("CDS")))

  # set system variable and check key again
  Sys.setenv(ecmwfr_PAT=Sys.getenv("CDS"))
  expect_identical(wf_get_key(), Sys.getenv("CDS"))
})

test_that("cds datasets returns data.frame or list", {
  skip_on_cran()
  skip_if(login_check)
  expect_true(inherits(wf_datasets(simplify = TRUE), "data.frame"))
  expect_true(inherits(wf_datasets(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(
      request = cds_request,
      transfer = TRUE
      )
    )

  # timeout trigger
  expect_message(
    wf_request(
      request = cds_request,
      time_out = -1,
      transfer = TRUE
      )
    )

  # job test (can't run headless)
  if(ON_GIT){
    expect_error(
      wf_request(
        request = cds_request,
        transfer = TRUE,
        job_name = "jobtest"
      )
    )
  }

  # faulty request
  expect_error(
    wf_request(
      request = cds_request_faulty
    )
  )

  # wrong request
  expect_error(
    wf_request(
      request = "xyz",
      transfer = TRUE
      )
    )

  # missing request
  expect_error(wf_request(
    transfer = TRUE
    )
  )

  # R6 testing
  r <- wf_request(
    request = cds_request,
    transfer = FALSE
    )

  # is R6 class
  expect_true(inherits(r, "R6"))
  url <- r$get_url()

  # cleanup
  expect_message(
    r$delete()
  )

  # test delete routine
  expect_error(
    wf_delete(url = "50340909as")
  )

  # delete job with function not method
  r <- wf_request(
    request = cds_request,
    transfer = FALSE
  )

  # is R6 class
  url <- r$get_url()

  expect_message(
    wf_delete(url)
  )
})


# # 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(
    request = cds_request,
    transfer = FALSE
  )

  # CDS productinfo (requires at least 'user' and 'dataset')
  expect_error(wf_dataset_info())
  expect_error(wf_dataset_info(dataset = "foo"))

  # THIS FAILS: service too slow?
  # check transfer routine
  # Sys.sleep(120)
  # expect_output(
  #   wf_transfer(
  #     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(url = "http://google.com"))

  # check product listing
  expect_output(str(wf_dataset_info(
    "reanalysis-era5-single-levels",
    simplify = FALSE)))
})

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",
      variable = "geopotential",
      year = "2024",
      month = "03",
      day = "01",
      time = "13:00",
      pressure_level = "1000",
      data_format = "grib",
      area = c(51, 1, 50, 2),
      target = paste0(y, "-era5-demo.grib"))
  })

  expect_output(
    wf_request_batch(
    requests,
    retry = 5)
    )

  requests_dup <- lapply(requests, function(r) {
    r$target <- "era5.nc"
    r
  })

  expect_error(wf_request_batch(
    requests_dup)
  )

})