fix blob lease functions

DESCRIPTION

@@ -26,6 +26,7 @@ Suggests:
     rmarkdown,
     jsonlite,
     testthat,
-    processx
+    processx,
+    uuid
 Roxygen: list(markdown=TRUE, r6=FALSE, old_usage=TRUE)
 RoxygenNote: 7.1.1

NEWS.md

@@ -1,3 +1,7 @@
+# AzureStor 3.4.0.9000
+
+- Fix blob lease functions to work with blobs as well as containers (#77).
+
 # AzureStor 3.4.0
 
 - Add helper functions to transfer data in commonly-used formats. These work via connections and so do not create temporary files on disk.

R/blob_lease.R

@@ -27,7 +27,10 @@ acquire_lease <- function(container, blob="", duration=60, lease=NULL)
     headers <- list("x-ms-lease-action"="acquire", "x-ms-lease-duration"=duration)
     if(!is_empty(lease))
         headers <- c(headers, list("x-ms-proposed-lease-id"=lease))
-    res <- do_container_op(container, blob, options=list(comp="lease", restype="container"), headers=headers,
+    options <- list(comp="lease")
+    if(blob == "")
+        options$restype <- "container"
+    res <- do_container_op(container, blob, options=options, headers=headers,
                            http_verb="PUT", return_headers=TRUE)
     res[["x-ms-lease-id"]]
 }
@@ -40,7 +43,10 @@ break_lease <- function(container, blob="", period=NULL)
     headers <- list("x-ms-lease-action"="break")
     if(!is_empty(period))
         headers <- c(headers, list("x-ms-lease-break-period"=period))
-    invisible(do_container_op(container, blob, options=list(comp="lease", restype="container"), headers=headers,
+    options <- list(comp="lease")
+    if(blob == "")
+        options$restype <- "container"
+    invisible(do_container_op(container, blob, options=options, headers=headers,
                               http_verb="PUT"))
 }
 
@@ -50,7 +56,10 @@ break_lease <- function(container, blob="", period=NULL)
 release_lease <- function(container, blob="", lease)
 {
     headers <- list("x-ms-lease-id"=lease, "x-ms-lease-action"="release")
-    invisible(do_container_op(container, blob, options=list(comp="lease", restype="container"), headers=headers,
+    options <- list(comp="lease")
+    if(blob == "")
+        options$restype <- "container"
+    invisible(do_container_op(container, blob, options=options, headers=headers,
                               http_verb="PUT"))
 }
 
@@ -60,7 +69,10 @@ release_lease <- function(container, blob="", lease)
 renew_lease <- function(container, blob="", lease)
 {
     headers <- list("x-ms-lease-id"=lease, "x-ms-lease-action"="renew")
-    invisible(do_container_op(container, blob, options=list(comp="lease", restype="container"), headers=headers,
+    options <- list(comp="lease")
+    if(blob == "")
+        options$restype <- "container"
+    invisible(do_container_op(container, blob, options=options, headers=headers,
                               http_verb="PUT"))
 }
 
@@ -70,7 +82,10 @@ renew_lease <- function(container, blob="", lease)
 change_lease <- function(container, blob="", lease, new_lease)
 {
     headers <- list("x-ms-lease-id"=lease, "x-ms-lease-action"="change", "x-ms-proposed-lease-id"=new_lease)
-    res <- do_container_op(container, blob, options=list(comp="lease", restype="container"), headers=headers,
+    options <- list(comp="lease")
+    if(blob == "")
+        options$restype <- "container"
+    res <- do_container_op(container, blob, options=options, headers=headers,
                            http_verb="PUT", return_headers=TRUE)
     res[["x-ms-lease-id"]]
 }

tests/testthat/test02d_bloblease.R

@@ -0,0 +1,89 @@
+context("Blob leases")
+
+tenant <- Sys.getenv("AZ_TEST_TENANT_ID")
+app <- Sys.getenv("AZ_TEST_APP_ID")
+password <- Sys.getenv("AZ_TEST_PASSWORD")
+subscription <- Sys.getenv("AZ_TEST_SUBSCRIPTION")
+
+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")
+
+if(rgname == "" || storname == "")
+    skip("Blob lease tests skipped: resource names not set")
+
+sub <- AzureRMR::az_rm$new(tenant=tenant, app=app, password=password)$get_subscription(subscription)
+stor <- sub$get_resource_group(rgname)$get_storage_account(storname)
+
+bl <- stor$get_blob_endpoint()
+
+opts <- options(azure_storage_progress_bar=FALSE)
+
+
+test_that("Blob container leasing works",
+{
+    cont_name <- make_name(10)
+    cont <- create_blob_container(bl, cont_name)
+
+    lease1 <- acquire_lease(cont, duration=15)
+    expect_type(lease1, "character")
+
+    Sys.sleep(1)
+
+    lease2 <- change_lease(cont, lease=lease1, new_lease=uuid::UUIDgenerate())
+    expect_type(lease2, "character")
+
+    Sys.sleep(1)
+    expect_silent(renew_lease(cont, lease=lease2))
+    expect_error(delete_blob_container(cont, confirm=FALSE))
+    expect_silent(break_lease(cont))
+    expect_error(acquire_lease(cont, duration=15))
+
+    Sys.sleep(15)
+    expect_silent(lease3 <- acquire_lease(cont, duration=15))
+    expect_silent(release_lease(cont, lease=lease3))
+
+    Sys.sleep(2)
+    expect_silent(delete_blob_container(cont, confirm=FALSE))
+})
+
+
+test_that("Blob leasing works",
+{
+    cont_name <- make_name(10)
+    cont <- create_blob_container(bl, cont_name)
+
+    expect_silent(upload_blob(cont, "../resources/iris.csv"))
+
+    blname <- "iris.csv"
+    lease1 <- acquire_lease(cont, blname, duration=15)
+    expect_type(lease1, "character")
+
+    Sys.sleep(1)
+
+    lease2 <- change_lease(cont, blname, lease=lease1, new_lease=uuid::UUIDgenerate())
+    expect_type(lease2, "character")
+
+    Sys.sleep(1)
+    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))
+
+    Sys.sleep(15)
+    expect_silent(lease3 <- acquire_lease(cont, blname, duration=15))
+    expect_silent(release_lease(cont, blname, lease=lease3))
+
+    Sys.sleep(2)
+    expect_silent(delete_blob(cont, blname, confirm=FALSE))
+})
+
+
+teardown(
+{
+    options(opts)
+    conts <- list_blob_containers(bl)
+    lapply(conts, delete_blob_container, confirm=FALSE)
+})