tests/testthat/test-08-rdrop2-content-hash.R

In karthik/rdrop2: Programmatic Interface to the 'Dropbox' API

context("testing drop_content_hash")

test_that("known good values", {
  # These were generated by hand and tested - they serve as regression
  # tests and do not require dropbox access.

  four_mb <- 4L * 1024L * 1024L

  # one short string
  b1 <- charToRaw("hello rdrop2")
  # one complete block
  b2 <- as.raw(rep(0:255, length.out = four_mb))
  # one block plus one byte
  b3 <- c(b2, as.raw(255L))
  # several blocks
  b4 <- as.raw(rep(0:255, length.out = 3.5 * four_mb))

  h1 <- "1aa2b7623dfff520c4abdc1227d10bc4e229b74005b66b3458345830e556f4de"
  h2 <- "894bbb52d1212d6bcbe9967f1a2169138c4d4af0c8dfbaeae86cd1d3f0c03faf"
  h3 <- "9149387a91f71c7c2149b8427d15526b71c1a38d6c6f999ad71486a2ce788d57"
  h4 <- "f61d3ae93fa4f7646d37949fc0885141bf682faa9a130896b93459c650335d0f"

  write_bytes <- function(bytes) {
    path <- tempfile()
    writeBin(bytes, path)
    path
  }

  f1 <- write_bytes(b1)
  f2 <- write_bytes(b2)
  f3 <- write_bytes(b3)
  f4 <- write_bytes(b4)

  on.exit(unlink(c(f1, f2, f3, f4)))

  expect_equal(drop_content_hash(f1), h1)
  expect_equal(drop_content_hash(f2), h2)
  expect_equal(drop_content_hash(f3), h3)
  expect_equal(drop_content_hash(f4), h4)

  ## This is what is actually going on:
  expect_equal(sha256(sha256(b1, TRUE), FALSE), h1)
  expect_equal(sha256(sha256(b2, TRUE), FALSE), h2)
  expect_equal(sha256(c(sha256(b3[seq_len(four_mb)], TRUE),
                        sha256(b3[-seq_len(four_mb)], TRUE)),
                      FALSE), h3)
})

test_that("vectorisation", {
  write_bytes <- function(bytes) {
    path <- tempfile()
    writeBin(bytes, path)
    path
  }

  paths <- vapply(1:5, function(.) write_bytes(sample(as.raw(0:255))),
                  character(1))
  hash <- vapply(paths, drop_content_hash, character(1))

  expect_equal(drop_content_hash(paths), unname(hash))
  expect_equal(drop_content_hash(character(0)), character(0))
  i <- c(1, 1, 2, 3)
  expect_equal(drop_content_hash(paths[i]), unname(hash)[i])
})

test_that("content_hash agrees with dropbox", {
  skip_on_cran()

  # create folders and objects
  folder_name <- traceless("test-drop_dir")
  drop_create(folder_name)

  file_name <- traceless("test-drop_dir.csv")
  write.csv(mtcars, file_name)
  drop_upload(file_name, path = folder_name)

  on.exit({
    drop_delete(folder_name)
    unlink(file_name)
  })

  info <- drop_dir(folder_name)
  expect_equal(drop_content_hash(file_name), info$content_hash)
})


test_that("input validation", {
  expect_error(drop_content_hash(1:10),
               "Expected 'file' to be a character vector")
})