Lease fix (#80)

* add lease header to put-blocklist

* load pkgs quietly

* fix for new behaviour with append blobs and hns

* also test blob transfers

* also test adls lease

* reword news

NEWS.md

@@ -1,6 +1,6 @@
 # AzureStor 3.4.0.9000
 
-- Fix blob lease functions to work with blobs as well as containers (#77).
+- Fix blob lease code that has been broken since launch (#77, #78).
 
 # AzureStor 3.4.0
 

R/adls_transfer_internal.R

@@ -26,6 +26,8 @@ upload_adls_file_internal <- function(filesystem, src, dest, blocksize=2^24, lea
             `content-length`=sprintf("%.0f", thisblock),
             `content-md5`=encode_md5(body)
         )
+        if(!is.null(lease))
+            headers$`x-ms-lease-id` <- as.character(lease)
         do_container_op(filesystem, dest, headers=headers, body=body, options=opts, progress=bar$update(),
                         http_verb="PATCH")
 
@@ -39,6 +41,8 @@ upload_adls_file_internal <- function(filesystem, src, dest, blocksize=2^24, lea
     headers <- list(`content-type`=src$content_type)
     if(!is.null(src$md5))
         headers$`x-ms-content-md5` <- src$md5
+    if(!is.null(lease))
+        headers$`x-ms-lease-id` <- as.character(lease)
     do_container_op(filesystem, dest,
                     options=list(action="flush", position=sprintf("%.0f", pos)),
                     headers=headers,

R/azcopy.R

@@ -55,7 +55,7 @@ call_azcopy <- function(..., env=NULL, silent=getOption("azure_storage_azcopy_si
 
 call_azcopy_from_storage <- function(object, ...)
 {
-    if(!requireNamespace("processx"))
+    if(!requireNamespace("processx", quietly=TRUE))
         stop("The processx package must be installed to use azcopy", call.=FALSE)
 
     auth <- azcopy_auth(object)
@@ -84,6 +84,8 @@ azcopy_upload_opts <- function(container, ...)
 azcopy_upload_opts.blob_container <- function(container, type="BlockBlob", blocksize=2^24, recursive=FALSE,
                                               lease=NULL, put_md5=FALSE, ...)
 {
+    if(!is.null(lease))
+        warning("azcopy does not support blob leasing at this time", call.=FALSE)
     c("--blob-type", type, "--block-size-mb", sprintf("%.0f", blocksize/1048576), if(recursive) "--recursive",
       if(put_md5) "--put-md5")
 }
@@ -97,6 +99,8 @@ azcopy_upload_opts.file_share <- function(container, blocksize=2^22, recursive=F
 azcopy_upload_opts.adls_filesystem <- function(container, blocksize=2^24, recursive=FALSE, lease=NULL,
                                                put_md5=FALSE, ...)
 {
+    if(!is.null(lease))
+        warning("azcopy does not support blob leasing at this time", call.=FALSE)
     c("--block-size-mb", sprintf("%.0f", blocksize/1048576), if(recursive) "--recursive",
       if(put_md5) "--put-md5")
 }

R/blob_upload_internal.R

@@ -42,6 +42,8 @@ upload_block_blob <- function(container, src, dest, blocksize, lease)
     )
     if(!is.null(src$md5))
         headers[["x-ms-blob-content-md5"]] <- src$md5
+    if(!is.null(lease))
+        headers[["x-ms-lease-id"]] <- as.character(lease)
 
     do_container_op(container, dest, headers=headers, body=body, options=list(comp="blocklist"),
                     http_verb="PUT")

R/transfer_format_utils.R

@@ -96,7 +96,7 @@ storage_load_rdata <- function(container, file, envir=parent.frame(), ...)
 #' @export
 storage_write_delim <- function(object, container, file, delim="\t", ...)
 {
-    func <- if(requireNamespace("readr"))
+    func <- if(requireNamespace("readr", quietly=TRUE))
         storage_write_delim_readr
     else storage_write_delim_base
     func(object, container, file, delim=delim, ...)
@@ -125,7 +125,7 @@ storage_write_delim_base <- function(object, container, file, delim="\t", ...)
 #' @export
 storage_write_csv <- function(object, container, file, ...)
 {
-    func <- if(requireNamespace("readr"))
+    func <- if(requireNamespace("readr", quietly=TRUE))
         storage_write_csv_readr
     else storage_write_csv_base
     func(object, container, file, ...)
@@ -148,7 +148,7 @@ storage_write_csv_base <- function(object, container, file, ...)
 #' @export
 storage_write_csv2 <- function(object, container, file, ...)
 {
-    func <- if(requireNamespace("readr"))
+    func <- if(requireNamespace("readr", quietly=TRUE))
         storage_write_csv2_readr
     else storage_write_csv2_base
     func(object, container, file, ...)
@@ -174,7 +174,7 @@ storage_write_csv2_base <- function(object, container, file, ...)
 #' @export
 storage_read_delim <- function(container, file, delim="\t", ...)
 {
-    func <- if(requireNamespace("readr"))
+    func <- if(requireNamespace("readr", quietly=TRUE))
         storage_read_delim_readr
     else storage_read_delim_base
     func(container, file, delim=delim, ...)
@@ -199,7 +199,7 @@ storage_read_delim_base <- function(container, file, delim="\t", ...)
 #' @export
 storage_read_csv <- function(container, file, ...)
 {
-    func <- if(requireNamespace("readr"))
+    func <- if(requireNamespace("readr", quietly=TRUE))
         storage_read_csv_readr
     else storage_read_csv_base
     func(container, file, ...)
@@ -222,7 +222,7 @@ storage_read_csv_base <- function(container, file, ...)
 #' @export
 storage_read_csv2 <- function(container, file, ...)
 {
-    func <- if(requireNamespace("readr"))
+    func <- if(requireNamespace("readr", quietly=TRUE))
         storage_read_csv2_readr
     else storage_read_csv2_base
     func(container, file, ...)

tests/testthat/test08_interop1.R

@@ -66,8 +66,8 @@ test_that("Blob vector multitransfer works",
     contname <- paste0(sample(letters, 10, TRUE), collapse="")
     cont <- create_blob_container(bl, contname)
 
-    # test that extra args passed to nodes
-    expect_error(multiupload_blob(cont, file.path(srcdir, srcs), type="AppendBlob"))
+    # test that extra args passed to nodes: append blobs not (yet) supported on HNS accts
+    expect_error(multiupload_blob(cont, file.path(srcdir, srcs), paste0(srcs, "_bad"), type="AppendBlob"))
 
     multiupload_blob(cont, file.path(srcdir, srcs), srcs)
     multidownload_blob(cont, srcs, file.path(destdir, srcs))

tests/testthat/test15_lease.R

@@ -1,4 +1,4 @@
-context("Blob leases")
+context("Blob/ADLS leases")
 
 tenant <- Sys.getenv("AZ_TEST_TENANT_ID")
 app <- Sys.getenv("AZ_TEST_APP_ID")
@@ -9,7 +9,7 @@ if(tenant == "" || app == "" || password == "" || subscription == "")
     skip("Authentication tests skipped: ARM credentials not set")
 
 rgname <- Sys.getenv("AZ_TEST_STORAGE_RG")
-storname <- Sys.getenv("AZ_TEST_STORAGE_NOHNS")
+storname <- Sys.getenv("AZ_TEST_STORAGE_HNS")
 
 if(rgname == "" || storname == "")
     skip("Blob lease tests skipped: resource names not set")
@@ -18,6 +18,7 @@ sub <- AzureRMR::az_rm$new(tenant=tenant, app=app, password=password)$get_subscr
 stor <- sub$get_resource_group(rgname)$get_storage_account(storname)
 
 bl <- stor$get_blob_endpoint()
+ad <- stor$get_adls_endpoint()
 
 opts <- options(azure_storage_progress_bar=FALSE)
 
@@ -54,29 +55,33 @@ test_that("Blob leasing works",
 {
     cont_name <- make_name(10)
     cont <- create_blob_container(bl, cont_name)
+    fs <- adls_filesystem(ad, cont_name)
 
     expect_silent(upload_blob(cont, "../resources/iris.csv"))
 
     blname <- "iris.csv"
-    lease1 <- acquire_lease(cont, blname, duration=15)
+    lease1 <- acquire_lease(cont, blname, duration=-1)
     expect_type(lease1, "character")
 
     Sys.sleep(1)
+    expect_error(upload_blob(cont, "../resources/iris.csv"))
+    expect_error(upload_adls_file(fs, "../resources/iris.csv"))
 
     lease2 <- change_lease(cont, blname, lease=lease1, new_lease=uuid::UUIDgenerate())
     expect_type(lease2, "character")
 
-    Sys.sleep(1)
+    expect_silent(upload_blob(cont, "../resources/iris.csv", lease=lease2))
+    expect_silent(upload_adls_file(fs, "../resources/iris.csv", lease=lease2))
     expect_silent(renew_lease(cont, blname, lease=lease2))
     expect_error(delete_blob(cont, blname, confirm=FALSE))
-    expect_silent(break_lease(cont, blname))
-    expect_error(acquire_lease(cont, blname, duration=15))
+    expect_silent(break_lease(cont, blname, period=10))
+    expect_error(acquire_lease(cont, blname, duration=-1))
 
-    Sys.sleep(15)
+    expect_silent(release_lease(cont, blname, lease=lease2))
     expect_silent(lease3 <- acquire_lease(cont, blname, duration=15))
-    expect_silent(release_lease(cont, blname, lease=lease3))
 
     Sys.sleep(2)
+    expect_silent(release_lease(cont, blname, lease=lease3))
     expect_silent(delete_blob(cont, blname, confirm=FALSE))
 })