Add initial tests

tests/testthat.R

@@ -0,0 +1,12 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(jupycost)
+
+test_check("jupycost")

tests/testthat/_snaps/cost-summaries.md

@@ -0,0 +1,32 @@
+# get_daily_usage_costs input validation works
+
+    Code
+      get_daily_usage_costs(end_date = "not a date")
+    Condition
+      Error in `get_daily_usage_costs()`:
+      ! `end_date` must be a length 1 Date or POSIXt object, or character in a standard unambiguous date format
+
+---
+
+    Code
+      get_daily_usage_costs(months_back = 13)
+    Condition
+      Error in `get_daily_usage_costs()`:
+      ! `months_back` must be an integer <= 12.
+
+---
+
+    Code
+      get_daily_usage_costs(months_back = 1.5)
+    Condition
+      Error in `get_daily_usage_costs()`:
+      ! `months_back` must be an integer <= 12.
+
+---
+
+    Code
+      get_daily_usage_costs(cost_type = "invalid")
+    Condition
+      Error in `match.arg()`:
+      ! 'arg' should be one of "unblended", "blended", "all"
+

tests/testthat/_snaps/utils.md

@@ -0,0 +1,48 @@
+# check_valid_date errors informatively for invalid inputs
+
+    Code
+      check_valid_date("not a date")
+    Condition
+      Error:
+      ! `"not a date"` must be a length 1 Date or POSIXt object, or character in a standard unambiguous date format
+
+---
+
+    Code
+      check_valid_date("2024-35-19")
+    Condition
+      Error:
+      ! `"2024-35-19"` must be a length 1 Date or POSIXt object, or character in a standard unambiguous date format
+
+---
+
+    Code
+      check_valid_date(c("2024-01-01", "2024-01-02"))
+    Condition
+      Error:
+      ! `c("2024-01-01", "2024-01-02")` must be a length 1 Date or POSIXt object, or character in a standard unambiguous date format
+
+---
+
+    Code
+      check_valid_date(NA_character_)
+    Condition
+      Error:
+      ! `NA_character_` must be a length 1 Date or POSIXt object, or character in a standard unambiguous date format
+
+---
+
+    Code
+      check_valid_date(NULL)
+    Condition
+      Error:
+      ! `NULL` must be a length 1 Date or POSIXt object, or character in a standard unambiguous date format
+
+# check_valid_date includes argument name in error
+
+    Code
+      check_valid_date("not a date", arg = "my_date")
+    Condition
+      Error:
+      ! `my_date` must be a length 1 Date or POSIXt object, or character in a standard unambiguous date format
+

tests/testthat/helper.R

@@ -0,0 +1,59 @@
+#' Set environment variables for testing
+#'
+#' This is kind of a remake of withr::local_envvar() but gets the env var values
+#' from the prefixed versions of the vars, and does the test skips if not set.
+#'
+#' @param org One of `"nasa"` or `"nmfs"`.
+#' @param env The environment in which to restore the original environment variables.
+#'
+#' @returns
+#' `TRUE` if all environment variables were successfully set and are non-empty.
+#' Otherwise, skips the test and returns `FALSE`. Environment variables are
+#' automatically restored to their original values when the environment is cleaned up.
+set_env_vars <- function(org = c("nasa", "nmfs"), env = parent.frame()) {
+  org <- match.arg(org)
+
+  env_var_names <- c(
+    "GRAFANA_TOKEN",
+    "AWS_ACCESS_KEY_ID",
+    "AWS_SECRET_ACCESS_KEY",
+    "AWS_REGION"
+  )
+
+  env_vars_init <- Sys.getenv(env_var_names)
+
+  env_vars <- vapply(
+    env_var_names,
+    \(x) {
+      Sys.getenv(
+        glue::glue("{toupper(org)}_{x}")
+      )
+    },
+    FUN.VALUE = character(1),
+    USE.NAMES = TRUE
+  )
+
+  env_vars["AWS_REGION"] <- "us-east-1"
+
+  were_vars_set <- do.call(Sys.setenv, as.list(env_vars))
+
+  withr::defer(do.call(Sys.setenv, as.list(env_vars_init)), envir = env)
+
+  if (any(!were_vars_set)) {
+    skip_cli("{.var {names(env_vars)[!were_vars_set]}} env var{?s} not set")
+    return(FALSE)
+  }
+
+  empty_vars <- !nzchar(Sys.getenv(names(env_vars)))
+
+  if (any(empty_vars)) {
+    skip_cli("{.var {names(env_vars)[empty_vars]}} env var{?s} empty")
+    return(FALSE)
+  }
+
+  TRUE
+}
+
+skip_cli <- function(x, ...) {
+  testthat::skip(cli::cli_fmt(cli::cli_text(x, ...)))
+}

tests/testthat/test-cost-summaries.R

@@ -0,0 +1,91 @@
+test_that("get_daily_usage_costs input validation works", {
+  expect_snapshot(
+    error = TRUE,
+    get_daily_usage_costs(end_date = "not a date")
+  )
+
+  expect_snapshot(
+    error = TRUE,
+    get_daily_usage_costs(months_back = 13)
+  )
+
+  expect_snapshot(
+    error = TRUE,
+    get_daily_usage_costs(months_back = 1.5)
+  )
+
+  expect_snapshot(
+    error = TRUE,
+    get_daily_usage_costs(cost_type = "invalid")
+  )
+})
+
+test_that("get_daily_usage_costs returns expected format", {
+  mock_data <- data.frame(
+    id = "unblended",
+    date = as.Date("2023-01-01"),
+    service = "foo",
+    linked_account = "123",
+    cost = 10
+  )
+
+  local_mocked_bindings(
+    "aws_billing" = function(...) mock_data,
+    .package = "sixtyfour"
+  )
+
+  result <- get_daily_usage_costs(
+    end_date = as.Date("2024-06-01"),
+    months_back = 1
+  )
+
+  expect_s3_class(result, "data.frame")
+  expect_true(inherits(result$date, "Date"))
+})
+
+test_that("get_daily_usage_costs filters by cost_type correctly", {
+  mock_data <- data.frame(
+    id = c("unblended", "blended"),
+    date = as.Date("2023-01-01"),
+    service = "foo",
+    linked_account = "123",
+    cost = c(10, 20)
+  )
+
+  local_mocked_bindings(
+    "aws_billing" = function(...) mock_data,
+    .package = "sixtyfour"
+  )
+
+  unblended_result <- get_daily_usage_costs(cost_type = "unblended")
+  expect_equal(nrow(unblended_result), 1)
+  expect_equal(unblended_result$id, "unblended")
+
+  all_result <- get_daily_usage_costs(cost_type = "all")
+  expect_equal(nrow(all_result), 2)
+  expect_equal(all_result$id, c("unblended", "blended"))
+})
+
+test_that("get_daily_usage_costs() works for real with nasa env vars", {
+  set_env_vars("nasa")
+
+  ret <- get_daily_usage_costs(months_back = 1)
+  expect_s3_class(ret, "data.frame")
+  expect_named(
+    ret,
+    c("id", "date", "service", "linked_account", "cost", "acronym")
+  )
+  expect_gt(nrow(ret), 0)
+})
+
+test_that("get_daily_usage_costs() works for real with nmfs env vars", {
+  set_env_vars("nmfs")
+
+  ret <- get_daily_usage_costs(months_back = 1)
+  expect_s3_class(ret, "data.frame")
+  expect_named(
+    ret,
+    c("id", "date", "service", "linked_account", "cost", "acronym")
+  )
+  expect_gt(nrow(ret), 0)
+})

tests/testthat/test-prometheus.R

@@ -0,0 +1,98 @@
+test_that("get_default_prometheus_uid works", {
+  mock_response <- list(
+    list(name = "other", uid = "123"),
+    list(name = "prometheus", uid = "abc", isDefault = FALSE)
+  )
+
+  local_mocked_bindings(
+    req_perform = function(...) structure(list(), class = "httr2_response"),
+    resp_body_json = function(...) mock_response,
+    .package = "httr2"
+  )
+
+  expect_equal(get_default_prometheus_uid(), "abc")
+})
+
+test_that("get_prometheus_labels works", {
+  mock_response <- c("label1", "label2")
+
+  local_mocked_bindings(
+    req_perform = function(...) structure(list(), class = "httr2_response"),
+    resp_body_json = function(...) mock_response,
+    resp_check_status = function(x) x,
+    .package = "httr2"
+  )
+
+  expect_equal(get_prometheus_labels(), mock_response)
+})
+
+test_that("get_prometheus_metrics works", {
+  mock_response <- list(
+    data = list(
+      target = data.frame(col1 = 1),
+      metric = "metric1",
+      type = "gauge",
+      help = "help text",
+      unit = "bytes"
+    )
+  )
+
+  local_mocked_bindings(
+    req_perform = function(...) structure(list(), class = "httr2_response"),
+    resp_body_json = function(...) mock_response,
+    resp_check_status = function(x) x,
+    .package = "httr2"
+  )
+
+  result <- get_prometheus_metrics()
+  expect_true(is.data.frame(result))
+  expect_equal(names(result), c("col1", "metric", "type", "help", "unit"))
+})
+
+test_that("create_range_df works with provided data", {
+  input <- list(
+    data = list(
+      result = list(
+        metric = data.frame(job = "test_job"),
+        values = list(
+          data.frame(
+            V1 = 1704067200,
+            V2 = "123.45"
+          )
+        )
+      )
+    )
+  )
+
+  result <- create_range_df(input, "test_value")
+
+  expect_equal(names(result), c("job", "date", "test_value"))
+  expect_s3_class(result$date, "POSIXct")
+  expect_type(result$test_value, "double")
+  expect_equal(result$job, "test_job")
+})
+
+test_that("query_prometheus_range() works with nasa", {
+  set_env_vars("nasa")
+
+  ret <- query_prometheus_range(
+    query = "max(dirsize_total_size_bytes)",
+    step = "24h0m0s"
+  )
+
+  expect_type(ret, "list")
+  expect_named(ret, c("status", "data"))
+})
+
+test_that("query_prometheus_range() works with nmfs", {
+  set_env_vars("nmfs")
+
+  ret <- query_prometheus_range(
+    grafana_url = "https://grafana.nmfs-openscapes.2i2c.cloud",
+    query = "max(dirsize_total_size_bytes)",
+    step = "24h0m0s"
+  )
+
+  expect_type(ret, "list")
+  expect_named(ret, c("status", "data"))
+})

tests/testthat/test-utils.R

@@ -0,0 +1,28 @@
+test_that("unsanitize_dir_names reverses sanitization", {
+  expect_equal(unsanitize_dir_names("hello-2dworld"), "hello-world")
+  expect_equal(unsanitize_dir_names("hello-2eworld"), "hello.world")
+  expect_equal(unsanitize_dir_names("hello-40world"), "hello@world")
+  expect_equal(unsanitize_dir_names("hello-5fworld"), "hello_world")
+  expect_equal(
+    unsanitize_dir_names("hello-2dworld-2etest-40example-5ffile"),
+    "hello-world.test@example_file"
+  )
+})
+
+test_that("check_valid_date accepts valid date inputs", {
+  expect_equal(check_valid_date(Sys.Date()), Sys.Date())
+  expect_equal(check_valid_date("2024-01-01"), as.Date("2024-01-01"))
+  expect_equal(check_valid_date(as.POSIXct("2024-01-01")), as.Date("2024-01-01"))
+})
+
+test_that("check_valid_date errors informatively for invalid inputs", {
+  expect_snapshot(check_valid_date("not a date"), error = TRUE)
+  expect_snapshot(check_valid_date("2024-35-19"), error = TRUE)
+  expect_snapshot(check_valid_date(c("2024-01-01", "2024-01-02")), error = TRUE)
+  expect_snapshot(check_valid_date(NA_character_), error = TRUE)
+  expect_snapshot(check_valid_date(NULL), error = TRUE)
+})
+
+test_that("check_valid_date includes argument name in error", {
+  expect_snapshot(check_valid_date("not a date", arg = "my_date"), error = TRUE)
+})