tests/testthat/test-project.R

In reichlab/zoltr: Interface to the 'Zoltar' Forecast Repository API

context("project")

library(httr)
library(jsonlite)
library(testthat)
library(webmockr)
library(zoltr)


TWO_PROJECTS_JSON <- jsonlite::read_json("data/projects-list.json")

test_that("create_project() creates a Project", {
  zoltar_connection <- new_connection("http://example.com")
  webmockr::stub_request("post", uri = "http://example.com/api/projects/") %>%
    to_return(
      body = TWO_PROJECTS_JSON[[1]],
      status = 200,
      headers = list('Content-Type' = 'application/json; charset=utf-8'))
  project_config <- jsonlite::read_json("data/cdc-project.json")
  testthat::with_mock("httr::POST" = function(...) {
    called_args <<- list(...)
    load("data/get_token_response.rda")  # 'response' contains a 200 response from a sample `get_token()` call via `zoltar_authenticate()`
    response  # actual response doesn't matter, just its class
  },
                      create_project(zoltar_connection, project_config))
  expect_equal(called_args$url, "http://example.com/api/projects/")
  expect_equal(called_args$body, jsonlite::toJSON(list(project_config = project_config),
                                                  auto_unbox = TRUE, null = "null"))
})


test_that("create_project() calls re_authenticate_if_necessary(), and returns a Project URL", {
  zoltar_connection <- new_connection("http://example.com")
  m <- mock()
  testthat::with_mock("zoltr::re_authenticate_if_necessary" = m, {
    webmockr::stub_request("post", uri = "http://example.com/api/projects/") %>%
      to_return(
        body = TWO_PROJECTS_JSON[[1]],
        status = 200,
        headers = list('Content-Type' = 'application/json; charset=utf-8'))
    project_config <- jsonlite::read_json("data/cdc-project.json")
    project_url <- create_project(zoltar_connection, project_config)
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(project_url, "http://example.com/api/project/1/")
  })
})


test_that("submit_query() calls re_authenticate_if_necessary()", {
  zoltar_connection <- new_connection("http://example.com")

  # test `query_type = "forecasts"` POSTs to correct uri
  m <- mock()
  # NB: todo this overrides `test_that("submit_query() creates a Job"` !?:
  job_json <- jsonlite::read_json("data/job-2.json")
  testthat::with_mock("zoltr::re_authenticate_if_necessary" = m, {
    webmockr::stub_request("post", uri = "http://example.com/api/project/1/forecast_queries/") %>%
      to_return(
        body = job_json,
        status = 200,
        headers = list('Content-Type' = 'application/json; charset=utf-8'))
    submit_query(zoltar_connection, "http://example.com/api/project/1/", "forecasts", list())
    expect_equal(length(mock_calls(m)), 1)
  })


  # test `query_type = "truth"` POSTs to correct uri
  m <- mock()
  # NB: todo this overrides `test_that("submit_query() creates a Job"` !?:
  job_json <- jsonlite::read_json("data/job-2.json")
  testthat::with_mock("zoltr::re_authenticate_if_necessary" = m, {
    webmockr::stub_request("post", uri = "http://example.com/api/project/1/truth_queries/") %>%
      to_return(
        body = job_json,
        status = 200,
        headers = list('Content-Type' = 'application/json; charset=utf-8'))
    submit_query(zoltar_connection, "http://example.com/api/project/1/", "truth", list())
    expect_equal(length(mock_calls(m)), 1)
  })
})


test_that("delete_project() calls delete_resource", {
  zoltar_connection <- new_connection("http://example.com")
  m <- mock()
  testthat::with_mock("zoltr::delete_resource" = m, {
    delete_project(zoltar_connection, "http://example.com/api/project/0/")
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(mock_args(m)[[1]][[2]], "http://example.com/api/project/0/")
  })
})


test_that("models() returns a data.frame", {
  zoltar_connection <- new_connection("http://example.com")
  models_list_json <- jsonlite::read_json("data/models-list.json")
  m <- mock(models_list_json)  # return values in calling order
  testthat::with_mock("zoltr::get_resource" = m, {
    the_models <- models(zoltar_connection, "http://example.com/api/project/1/")
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(mock_args(m)[[1]][[2]], "http://example.com/api/project/1/models/")
    expect_is(the_models, "data.frame")
    expect_equal(names(the_models), c("id", "url", "project_url", "owner_url", "name", "model_abbr", "notes",
                                      "description", "home_url", "aux_data_url"))
    expect_equal(nrow(the_models), 1)  # 1 model
    expect_equal(ncol(the_models), 10)
  })
})


test_that("zoltar_units() returns a data.frame", {
  zoltar_connection <- new_connection("http://example.com")
  units_list_json <- jsonlite::read_json("data/units-list.json")
  m <- mock(units_list_json)  # return values in calling order
  testthat::with_mock("zoltr::get_resource" = m, {
    the_units <- zoltar_units(zoltar_connection, "http://example.com/api/project/1/")
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(mock_args(m)[[1]][[2]], "http://example.com/api/project/1/units/")
    expect_is(the_units, "data.frame")
    expect_equal(names(the_units), c("id", "url", "abbreviation", "name"))
    expect_equal(nrow(the_units), 3)  # 3 units
    expect_equal(ncol(the_units), 4)
  })
})


test_that("targets() returns a data.frame", {
  zoltar_connection <- new_connection("http://example.com")
  targets_list_json <- jsonlite::read_json("data/targets-list.json")
  m <- mock(targets_list_json)  # return values in calling order
  testthat::with_mock("zoltr::get_resource" = m, {
    the_targets <- targets(zoltar_connection, "http://example.com/api/project/1/")
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(mock_args(m)[[1]][[2]], "http://example.com/api/project/1/targets/")
    expect_is(the_targets, "data.frame")
    expect_equal(names(the_targets), c("id", "url", "name", "type", "description", "outcome_variable",
                                       "is_step_ahead", "numeric_horizon", "reference_date_type"))
    expect_equal(nrow(the_targets), 5)  # 5 targets
    expect_equal(ncol(the_targets), 9)
  })
})


test_that("timezeros() returns a data.frame", {
  zoltar_connection <- new_connection("http://example.com")
  timezeros_list_json <- jsonlite::read_json("data/timezeros-list.json")
  m <- mock(timezeros_list_json)  # return values in calling order
  testthat::with_mock("zoltr::get_resource" = m, {
    the_timezeros <- timezeros(zoltar_connection, "http://example.com/api/project/1/")
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(mock_args(m)[[1]][[2]], "http://example.com/api/project/1/timezeros/")
    expect_is(the_timezeros, "data.frame")
    expect_equal(names(the_timezeros), c("id", "url", "timezero_date", "data_version_date", "is_season_start",
                                         "season_name"))
    expect_equal(nrow(the_timezeros), 3)  # 5 timezeros
    expect_equal(ncol(the_timezeros), 6)

    timezero_row <- the_timezeros[1,]
    exp_row <- data.frame(id = 5L, url = "http://example.com/api/timezero/5/",
                          timezero_date = as.Date("2011-10-02", YYYY_MM_DD_DATE_FORMAT),
                          data_version_date = as.Date("2011-10-03", YYYY_MM_DD_DATE_FORMAT),
                          is_season_start = TRUE, season_name = "2011-2012", stringsAsFactors = FALSE)
    rownames(timezero_row) <- c()
    rownames(exp_row) <- c()
    expect_equal(timezero_row, exp_row)

    timezero_row <- the_timezeros[2,]
    exp_row <- data.frame(id = 6L, url = "http://example.com/api/timezero/6/",
                          timezero_date = as.Date("2011-10-09", YYYY_MM_DD_DATE_FORMAT),
                          data_version_date = as.Date(NA), is_season_start = FALSE, season_name = as.character(NA),
                          stringsAsFactors = FALSE)
    rownames(timezero_row) <- c()
    rownames(exp_row) <- c()
    expect_equal(timezero_row, exp_row)
  })
})


#
# ---- test query functions ----
#

test_that("submit_query() creates a Job", {
  zoltar_connection <- new_connection("http://example.com")

  # test correct url and args passed
  job_json <- jsonlite::read_json("data/job-2.json")
  webmockr::stub_request("post", uri = "http://example.com/api/project/1/forecast_queries/") %>%
    to_return(
      body = job_json,
      status = 200,
      headers = list('Content-Type' = 'application/json; charset=utf-8'))

  query <- list()
  testthat::with_mock("httr::POST" = function(...) {
    called_args <<- list(...)
    load("data/upload_response.rda")  # 'response' contains 200 response from sample upload_truth() call
    response  # actual response doesn't matter, just its class
  },
                      submit_query(zoltar_connection, "http://example.com/api/project/1/", "forecasts", query))
  expect_equal(called_args$url, "http://example.com/api/project/1/forecast_queries/")
  expect_equal(as.character(called_args$body), "{\"query\":{}}")  # due to httr/jsonlite fighting

  # test a job url is returned
  job_url <- submit_query(zoltar_connection, "http://example.com/api/project/1/", "forecasts", query)
  expect_equal(job_url, "http://example.com/api/job/2/")
})


test_that("json_for_query() is correct", {
  query_exp_chrs <- list(list(query = list(),
                              exp_chr = "{\"query\":{}}"),
                         list(query = list("models" = list()),
                              exp_chr = "{\"query\":{\"models\":[]}}"),
                         list(query = list("models" = list(1), "units" = list(2, 3)),
                              exp_chr = "{\"query\":{\"models\":[1],\"units\":[2,3]}}"),
                         list(query = list("types" = list("point", "quantile")),
                              exp_chr = "{\"query\":{\"types\":[\"point\",\"quantile\"]}}"),
                         list(query = list("types" = list("point")),
                              exp_chr = "{\"query\":{\"types\":[\"point\"]}}")
  )
  for (row in query_exp_chrs) {
    expect_equal(as.character(json_for_query(row$query)), row$exp_chr)
  }
})


#
# ---- test info functions ----
#

test_that("project_info() returns a list", {
  zoltar_connection <- new_connection("http://example.com")
  exp_project_info <- TWO_PROJECTS_JSON[[1]]
  m <- mock(exp_project_info)
  testthat::with_mock("zoltr::get_resource" = m, {
    act_truth_info <- project_info(zoltar_connection, "http://example.com/api/project/1/")
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(mock_args(m)[[1]][[2]], "http://example.com/api/project/1/")
    expect_is(act_truth_info, "list")
    expect_equal(act_truth_info, exp_project_info)
  })
})


test_that("target_info() returns a list", {
  zoltar_connection <- new_connection("http://example.com")
  targets_list_json <- jsonlite::read_json("data/targets-list.json")
  exp_target_info <- targets_list_json[[1]]
  m <- mock(exp_target_info)
  testthat::with_mock("zoltr::get_resource" = m, {
    act_target_info <- target_info(zoltar_connection, "http://example.com/api/target/1/")
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(mock_args(m)[[1]][[2]], "http://example.com/api/target/1/")
    expect_is(act_target_info, "list")
    expect_equal(act_target_info, exp_target_info)
  })
})


test_that("timezero_info() returns a list", {
  zoltar_connection <- new_connection("http://example.com")
  timezeros_list_json <- jsonlite::read_json("data/timezeros-list.json")
  exp_timezero_info <- timezeros_list_json[[1]]
  m <- mock(exp_timezero_info)
  testthat::with_mock("zoltr::get_resource" = m, {
    act_timezero_info <- timezero_info(zoltar_connection, "http://example.com/api/timezero/2/")
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(mock_args(m)[[1]][[2]], "http://example.com/api/timezero/2/")
    expect_is(act_timezero_info, "list")
    expect_equal(act_timezero_info, exp_timezero_info)
  })
})


test_that("unit_info() returns a list", {
  zoltar_connection <- new_connection("http://example.com")
  units_list_json <- jsonlite::read_json("data/units-list.json")
  exp_unit_info <- units_list_json[[1]]
  m <- mock(exp_unit_info)
  testthat::with_mock("zoltr::get_resource" = m, {
    act_unit_info <- unit_info(zoltar_connection, "http://example.com/api/unit/3/")
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(mock_args(m)[[1]][[2]], "http://example.com/api/unit/3/")
    expect_is(act_unit_info, "list")
    expect_equal(act_unit_info, exp_unit_info)
  })
})


test_that("truth_info() returns a list", {
  zoltar_connection <- new_connection("http://example.com")

  truth_info_json <- jsonlite::read_json("data/truth-info.json")
  m <- mock(truth_info_json)
  testthat::with_mock("zoltr::get_resource" = m, {
    exp_truth_info <- truth_info_json
    exp_truth_info$created_at <- as.Date(exp_truth_info$created_at)
    act_truth_info <- truth_info(zoltar_connection, "http://example.com/api/project/1/")
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(mock_args(m)[[1]][[2]], "http://example.com/api/project/1/truth/")
    expect_is(act_truth_info, "list")
    expect_equal(act_truth_info, exp_truth_info)
  })
})


#
# ---- test upload functions ----
#

test_that("upload_truth() creates a Job", {
  zoltar_connection <- new_connection("http://example.com")
  job_json <- jsonlite::read_json("data/job-2.json")
  mockery::stub(upload_truth, 'httr::upload_file', NULL)
  webmockr::stub_request("post", uri = "http://example.com/api/project/1/truth/") %>%
    to_return(
      body = job_json,
      status = 200,
      headers = list('Content-Type' = 'application/json; charset=utf-8'))

  testthat::with_mock("httr::POST" = function(...) {
    called_args <<- list(...)
    load("data/get_token_response.rda")  # 'response' contains a 200 response from a sample `get_token()` call via `zoltar_authenticate()`
    response  # actual response doesn't matter, just its class
  },
                      upload_truth(zoltar_connection, "http://example.com/api/project/1/",
                                   "data/docs-ground-truth-non-dup.csv"))
  expect_equal(called_args$url, "http://example.com/api/project/1/truth/")
  expect_equal(called_args$body$data_file, NULL)  # due to mockery::stub() calls elsewhere
})


test_that("upload_truth() returns a Job URL, and job_info() is correct", {
  # NB: following uses project/2 so that `stub_request` returns below job_json and not above project/1 one
  zoltar_connection <- new_connection("http://example.com")
  job_json <- jsonlite::read_json("data/job-1.json")
  mockery::stub(upload_truth, 'httr::upload_file', NULL)
  webmockr::stub_request("post", uri = "http://example.com/api/project/2/truth/") %>%
    to_return(
      body = job_json,
      status = 200,
      headers = list('Content-Type' = 'application/json; charset=utf-8'))
  job_url <- upload_truth(zoltar_connection, "http://example.com/api/project/2/",
                          "data/docs-ground-truth-non-dup.csv")
  expect_equal(job_url, "http://example.com/api/job/1/")

  # test job_info()
  exp_job_json <- job_json
  exp_job_json$status <- "SUCCESS"
  exp_job_json$created_at <- lubridate::parse_date_time(
    "2022-10-24T14:02:01.679789-04:00", DATE_TIME_TZ_FORMAT, exact = TRUE)
  exp_job_json$updated_at <- lubridate::parse_date_time(
    "2022-10-24T14:02:02.464451-04:00", DATE_TIME_TZ_FORMAT, exact = TRUE)
  exp_job_json$input_json <- list("type" = "UPLOAD_TRUTH", filename = "docs-ground-truth-non-dup.csv",
                                  "project_pk" = "41")
  exp_job_json$output_json <- list("num_rows" = 11,
                                   "missing_units" = list("loc1x", "loc2x"),
                                   "num_forecasts" = 3,
                                   "missing_targets" = list("cases next weekx"),
                                   "missing_time_zeros" = list(as.Date("2022-10-01", YYYY_MM_DD_DATE_FORMAT),
                                                               as.Date("2022-10-02", YYYY_MM_DD_DATE_FORMAT)))

  m <- mock(job_json)
  testthat::with_mock("zoltr::get_resource" = m, {
    the_job_info <- job_info(zoltar_connection, "http://example.com/api/job/1/")
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(mock_args(m)[[1]][[2]], "http://example.com/api/job/1/")
    expect_is(the_job_info, "list")
    expect_equal(the_job_info, exp_job_json)
  })
})


test_that("upload_truth() calls re_authenticate_if_necessary()", {
  zoltar_connection <- new_connection("http://example.com")
  m <- mock()
  testthat::with_mock("zoltr::re_authenticate_if_necessary" = m, {
    upload_truth(zoltar_connection, "http://example.com/api/project/1/",
                 "data/docs-ground-truth-non-dup.csv")
    expect_equal(length(mock_calls(m)), 1)
  })
})


test_that("upload_truth() passes correct url to POST()", {
  zoltar_connection <- new_connection("http://example.com")
  called_args <- NULL
  # Note: this file is a duplicate of vignettes one b/c I could not figure out how to access that directory for both
  # devtools::test() and devtools::check() (different working dirs):
  testthat::with_mock(
    "httr::POST" = function(...) {
      called_args <<- list(...)
      load("data/upload_response.rda")  # 'response' contains 200 response from sample upload_truth() call
      response
    },
    job_url <- upload_truth(zoltar_connection, "http://example.com/api/project/1/",
                            "data/docs-ground-truth-non-dup.csv"))
  expect_equal(called_args$url, "http://example.com/api/project/1/truth/")
  expect_s3_class(called_args$body$data_file, "form_file")
})


test_that("upload_truth() passes correct body to POST() for issued_at combinations", {
  zoltar_connection <- new_connection("http://example.com")
  called_args <- NULL
  # Note: this file is a duplicate of vignettes one b/c I could not figure out how to access that directory for both
  # devtools::test() and devtools::check() (different working dirs):

  # case: issued_at = NULL
  testthat::with_mock(
    "httr::POST" = function(...) {
      called_args <<- list(...)
      load("data/upload_response.rda")  # 'response' contains 200 response from sample upload_truth() call
      response
    },
    job_url <- upload_truth(zoltar_connection, "http://example.com/api/project/1/",
                            "data/docs-ground-truth-non-dup.csv"))
  expect_false("issued_at" %in% names(called_args))

  # case: issued_at = datetime
  issued_at <- "the issued_at"
  testthat::with_mock(
    "httr::POST" = function(...) {
      called_args <<- list(...)
      load("data/upload_response.rda")  # 'response' contains 200 response from sample upload_truth() call
      response
    },
    job_url <- upload_truth(zoltar_connection, "http://example.com/api/project/1/",
                            "data/docs-ground-truth-non-dup.csv", issued_at = issued_at))
  expect_equal(called_args$body$issued_at, issued_at)
})


test_that("upload_truth() requires a existing file", {
  # just a simple test to drive converting upload_truth() from file to list
  zoltar_connection <- new_connection("http://example.com")
  expect_error(upload_truth(zoltar_connection, "http://example.com/api/project/1/",
                            "data/not-a-real-file.csv"),
               "file.exists(path) is not TRUE", fixed = TRUE)
})


#
# ---- test create_timezero() ----
#

test_that("create_timezero() creates a TimeZero", {
  zoltar_connection <- new_connection("http://example.com")
  timezeros_list_json <- jsonlite::read_json("data/timezeros-list.json")
  timezero_info <- timezeros_list_json[[1]]    # "is_season_start": true, "season_name": "2011-2012"

  # test is_season_start=TRUE
  timezero_config <- list(timezero_date = "2022-11-08", data_version_date = "2022-11-09", is_season_start = TRUE,
                          season_name = "Fall 2022")
  webmockr::stub_request("post", uri = "http://example.com/api/project/1/timezeros/") %>%
    to_return(
      body = timezero_info,
      status = 200,
      headers = list('Content-Type' = 'application/json; charset=utf-8'))
  testthat::with_mock("httr::POST" = function(...) {
    called_args <<- list(...)
    load("data/get_token_response.rda")  # 'response' contains a 200 response from a sample `get_token()` call via `zoltar_authenticate()`
    response  # actual response doesn't matter, just its class
  },
                      create_timezero(zoltar_connection, "http://example.com/api/project/1/",
                                      timezero_config$timezero_date, timezero_config$data_version_date,
                                      timezero_config$is_season_start, timezero_config$season_name))
  expect_equal(called_args$url, "http://example.com/api/project/1/timezeros/")
  expect_equal(called_args$body$timezero_config, timezero_config)

  # test is_season_start=FALSE
  timezero_info <- timezeros_list_json[[2]]  # "is_season_start": false
  timezero_config <- list(timezero_date = "2022-11-08", data_version_date = "2022-11-09", is_season_start = FALSE)
  webmockr::stub_request("post", uri = "http://example.com/api/project/1/timezeros/") %>%
    to_return(
      body = timezero_info,
      status = 200,
      headers = list('Content-Type' = 'application/json; charset=utf-8'))
  testthat::with_mock("httr::POST" = function(...) {
    called_args <<- list(...)
    load("data/get_token_response.rda")  # 'response' contains a 200 response from a sample `get_token()` call via `zoltar_authenticate()`
    response  # actual response doesn't matter, just its class
  },
                      create_timezero(zoltar_connection, "http://example.com/api/project/1/",
                                      timezero_config$timezero_date, timezero_config$data_version_date,
                                      timezero_config$is_season_start))  # no season_name
  expect_equal(called_args$url, "http://example.com/api/project/1/timezeros/")
  expect_equal(called_args$body$timezero_config, timezero_config)
})


test_that("create_timezero() calls re_authenticate_if_necessary() and returns a TimeZero URL", {
  zoltar_connection <- new_connection("http://example.com")
  m <- mock()
  timezeros_list_json <- jsonlite::read_json("data/timezeros-list.json")
  timezero_info <- timezeros_list_json[[1]]    # "is_season_start": true, "season_name": "2011-2012"
  timezero_config <- list(timezero_date = "2022-11-08", data_version_date = "2022-11-09", is_season_start = TRUE,
                          season_name = "Fall 2022")
  testthat::with_mock("zoltr::re_authenticate_if_necessary" = m, {
    webmockr::stub_request("post", uri = "http://example.com/api/project/1/timezeros/") %>%
      to_return(
        body = timezero_info,
        status = 200,
        headers = list('Content-Type' = 'application/json; charset=utf-8'))
    timezero_url <- create_timezero(zoltar_connection, "http://example.com/api/project/1/",
                                    timezero_config$timezero_date, timezero_config$data_version_date,
                                    timezero_config$is_season_start, timezero_config$season_name)
    expect_equal(length(mock_calls(m)), 1)
    expect_equal(timezero_url, "http://example.com/api/timezero/5/")
  })
})