tests/testthat/test-object.R

In MolgenisArmadillo: Armadillo Client for the Armadillo Service

handle <- httr::handle("https://test.nl")
withr::local_options("MolgenisArmadillo.armadillo.handle" = handle)

test_that(".upload_object handles errors", {
  file <- tempfile()
  saveRDS(tibble::tribble(), file)
  on.exit(unlink(file))

  upload_file <- httr::upload_file(file)
  compress <- mock(".rds")

  stub_request("post",
               uri = "https://test.nl/storage/projects/project/objects") %>%
    wi_th(
      header = list("Content-Type" = "multipart/form-data"),
      body = list(
        file = upload_file,
        object = "example/test.rds"
      )
    ) %>%
    to_return(
      status = 404,
      body = "{
        \"message\": \"project not found\"
      }",
      headers = list("Content-Type" = "application/json")
    )

  expect_error(
    with_mock({
               .upload_object(
                 project = "project",
                 folder = "example",
                 object = datasets::iris,
                 name = "test",
                 compression_function = compress
               )},
    "tempfile" = function() {
      file
    }),
    "project not found"
  )
  stub_registry_clear()
})

test_that(".upload_object uploads object", {
  file <- tempfile()
  saveRDS(tibble::tribble(), file)
  on.exit(unlink(file))

  upload_file <- httr::upload_file(file)
  compress <- mock(".rds")

  stub_request("post",
               uri = "https://test.nl/storage/projects/project/objects") %>%
    wi_th(
      header = list("Content-Type" = "multipart/form-data"),
      body = list(
        file = upload_file,
        object = "example/test.rds"
      )
    ) %>%
    to_return(status = 204)

  expect_message(
    with_mock({
               .upload_object(
                 project = "project",
                 folder = "example",
                 object = datasets::iris,
                 name = "test",
                 compression_function = compress
               )},
    "tempfile" = function() {
      file
    }),
    "Uploaded example/test"
  )
  stub_registry_clear()
})

test_that(".list_objects_by_extension handles errors", {
  stub_request("get",
               uri = "https://test.nl/storage/projects/project/objects") %>%
    to_return(
      status = 404,
      body = "{
        \"message\": \"project not found\"
      }",
      headers = list("Content-Type" = "application/json")
    )

  expect_error(
    .list_objects_by_extension("project", ".rds"),
    "project not found"
  )

  stub_registry_clear()
})

test_that(".list_objects_by_extension lists the objects in a project", {
  stub_request("get",
               uri = "https://test.nl/storage/projects/project/objects") %>%
    to_return(
      status = 200,
      body = "[
        \"core/nonrep.parquet\",
        \"core/yearlyrep.parquet\",
        \"core/resource.rds\"
      ]",
      headers = list("Content-Type" = "application/json")
    )

  res <- .list_objects_by_extension("project", ".parquet")
  expect_equal(res, c("core/nonrep", "core/yearlyrep"))

  stub_registry_clear()
})

test_that(".delete_object handles errors", {
  stub_request("delete",
               uri = paste0("https://test.nl/storage/projects/project/",
                            "objects/core%2Fnonrep.parquet")) %>%
    to_return(
      status = 404,
      body = "{
        \"message\": \"object not found\"
      }",
      headers = list("Content-Type" = "application/json")
    )

  expect_error(
    .delete_object("project", "core", "nonrep", ".parquet"),
    "object not found"
  )

  stub_registry_clear()
})

test_that(".delete_object deletes an object", {
  stub_request("delete",
               uri = paste0("https://test.nl/storage/projects/project/objects/",
                            "core%2Fnonrep.parquet")) %>%
    to_return(
      status = 204
    )

  expect_message(
    .delete_object("project", "core", "nonrep", ".parquet"),
    "Deleted 'core/nonrep'"
  )

  stub_registry_clear()
})

test_that(".copy_object handles errors", {
  stub_request("post",
               uri = paste0("https://test.nl/storage/projects/project/objects/",
                            "core%2Fnonrep.parquet/copy")) %>%
    wi_th(
      headers = list("Accept" = "application/json"),
      body = list(name = "core/copy.parquet")
    ) %>%
    to_return(
      status = 409,
      body = "{
        \"message\": \"duplicate object\"
      }",
      headers = list("Content-Type" = "application/json")
    )

  expect_error(
    .copy_object(
      project = "project",
      folder = "core",
      name = "nonrep",
      new_folder = "core",
      new_name = "copy",
      extension = ".parquet"
    ),
    "duplicate object"
  )

  stub_registry_clear()
})

test_that(".copy_object warns if you copy an object onto itself", {
  expect_error(
    .copy_object(
      project = "project",
      folder = "folder",
      name = "test",
      extension = ".parquet"
    ),
    "Cannot copy table or resource onto itself\\."
  )
})

test_that(".copy_object copies object", {
  stub_request("post",
               uri = paste0("https://test.nl/storage/projects/project/objects/",
                            "core%2Fnonrep.parquet/copy")) %>%
    wi_th(
      headers = list("Accept" = "application/json"),
      body = list(name = "core/copy.parquet")
    ) %>%
    to_return(status = 204)

  expect_message(
    .copy_object(
      project = "project",
      folder = "core",
      name = "nonrep",
      new_folder = "core",
      new_name = "copy",
      extension = ".parquet"
    ),
    "Copied 'project/core/nonrep' to 'project/core/copy'"
  )

  stub_registry_clear()
})

test_that(".load_object handles errors", {
  stub_request("get",
               uri = paste0("https://test.nl/storage/projects/project/objects/",
                            "core%2Fnonrep.rds")) %>%
    wi_th(
      headers = list('Accept' = 
                       'application/json, text/xml, application/xml, */*',
                     'Authorization' = 'Bearer token',
                     'Content-Type' = 'application/octet-stream')
    ) %>%
    to_return(status = 401)

  expect_error(
    .load_object(
      project = "project",
      folder = "core",
      name = "nonrep",
      load_function = load,
      extension = ".rds"
    ),
    "Unauthorized"
  )

  stub_registry_clear()
})

test_that(".load_object loads the object from file", {
  file <- tempfile()
  data <- tibble::tribble(
    ~colA, ~colB,
    "a", 1,
    "b", 2,
    "c", 3
  )
  saveRDS(data, file)
  on.exit(unlink(file))

  save_object <- mock(invisible(file))

  load_table <- function(infile) {
    readRDS(infile)
  }

  stub_request("get",
               uri = paste0("https://test.nl/storage/projects/project/objects/",
                            "core%2Fnonrep.parquet")) %>%
    wi_th(
      headers = list('Accept' = 
                       'application/json, text/xml, application/xml, */*',
                     'Authorization' = 'Bearer token',
                     'Content-Type' = 'application/octet-stream')
    ) %>%
    to_return(status = 200, body = stringi::stri_read_raw(file))

  expect_silent(
    with_mock(
      {
        result <- .load_object(
          project = "project",
          folder = "core",
          name = "nonrep",
          load_function = load_table,
          extension = ".parquet"
        )
      },
      "tempfile" = function() {
        file
      }
    )
  )

  expect_equal(data, result)

  stub_registry_clear()
})

test_that(".move_object handles errors", {
  stub_request("post",
               uri = paste0("https://test.nl/storage/projects/project/objects/",
                            "core%2Fnonrep.parquet/move")) %>%
    wi_th(
      headers = list("Accept" = "application/json"),
      body = list(name = "other/renamed.parquet")
    ) %>%
    to_return(
      status = 409,
      body = "{
        \"message\": \"duplicate object\"
      }",
      headers = list("Content-Type" = "application/json")
    )

  expect_error(
    .move_object(
      project = "project",
      folder = "core",
      name = "nonrep",
      new_folder = "other",
      new_name = "renamed",
      extension = ".parquet"
    ),
    "duplicate object"
  )

  stub_registry_clear()
})

test_that(".move_object warns if you move an object onto itself", {
  expect_error(
    .move_object(
      project = "project",
      folder = "folder",
      name = "test",
      extension = ".parquet"
    ),
    "Cannot move table or resource onto itself\\."
  )
})

test_that(".move_object moves object", {
  stub_request("post",
               uri = paste0("https://test.nl/storage/projects/project/objects/",
                            "core%2Fnonrep.parquet/move")) %>%
    wi_th(
      headers = list("Accept" = "application/json"),
      body = list(name = "other/renamed.parquet")
    ) %>%
    to_return(status = 204)

  expect_message(
    .move_object(
      project = "project",
      folder = "core",
      name = "nonrep",
      new_folder = "other",
      new_name = "renamed",
      extension = ".parquet"
    ),
    "Moved 'project/core/nonrep' to 'project/other/renamed'"
  )

  stub_registry_clear()
})