Azure storage

DESCRIPTION

@@ -74,39 +74,45 @@ Imports:
   vctrs (>= 0.2.4),
   yaml (>= 2.2.1)
 Suggests:
-  bslib,
-  clustermq (>= 0.9.2),
-  crew (>= 0.9.0),
-  curl (>= 4.3),
-  DT (>= 0.14),
-  dplyr (>= 1.0.0),
-  fst (>= 0.9.2),
-  future (>= 1.19.1),
-  future.batchtools (>= 0.9.0),
-  future.callr (>= 0.6.0),
-  gargle (>= 1.2.0),
-  googleCloudStorageR (>= 0.7.0),
-  gt (>= 0.2.2),
-  keras (>= 2.2.5.0),
-  markdown (>= 1.1),
-  nanonext (>= 0.12.0),
-  rmarkdown (>= 2.4),
-  parallelly (>= 1.35.0),
-  paws.common (>= 0.6.4),
-  paws.storage (>= 0.4.0),
-  pkgload (>= 1.1.0),
-  processx (>= 3.4.3),
-  qs (>= 0.24.1),
-  reprex (>= 2.0.0),
-  rstudioapi (>= 0.11),
-  R.utils (>= 2.6.0),
-  shiny (>= 1.5.0),
-  shinybusy (>= 0.2.2),
-  shinyWidgets (>= 0.5.4),
-  testthat (>= 3.0.0),
-  torch (>= 0.1.0),
-  usethis (>= 1.6.3),
-  visNetwork (>= 2.1.2)
+    AzureAuth,
+    AzureRMR,
+    AzureStor,
+    bslib,
+    clustermq (>= 0.9.2),
+    crew (>= 0.9.0),
+    curl (>= 4.3),
+    DT (>= 0.14),
+    dplyr (>= 1.0.0),
+    fs,
+    fst (>= 0.9.2),
+    future (>= 1.19.1),
+    future.batchtools (>= 0.9.0),
+    future.callr (>= 0.6.0),
+    gargle (>= 1.2.0),
+    googleCloudStorageR (>= 0.7.0),
+    gt (>= 0.2.2),
+    keras (>= 2.2.5.0),
+    markdown (>= 1.1),
+    nanonext (>= 0.12.0),
+    rmarkdown (>= 2.4),
+    parallelly (>= 1.35.0),
+    paws.common (>= 0.6.4),
+    paws.storage (>= 0.4.0),
+    pkgload (>= 1.1.0),
+    processx (>= 3.4.3),
+    purrr,
+    qs (>= 0.24.1),
+    reprex (>= 2.0.0),
+    rstudioapi (>= 0.11),
+    R.utils (>= 2.6.0),
+    shiny (>= 1.5.0),
+    shinybusy (>= 0.2.2),
+    shinyWidgets (>= 0.5.4),
+    stringr,
+    testthat (>= 3.0.0),
+    torch (>= 0.1.0),
+    usethis (>= 1.6.3),
+    visNetwork (>= 2.1.2)
 Encoding: UTF-8
 Language: en-US
 VignetteBuilder: knitr

R/utils_azure.R

@@ -0,0 +1,174 @@
+# Semi-automated tests of Azure Storage integration live in tests/azure/. # nolint
+# These tests should not be fully automated because they automatically create
+# Azure storage containers (i.e., "buckets") and upload data, which could put an
+# unexpected and unfair burden on external contributors from the open source
+# community.
+# nocov start
+
+# TODO: implement "version" optional argument
+azure_head <- function(
+  key,
+  bucket,
+  endpoint,
+  version = NULL,
+  auth_key = NULL,
+  auth_token = azure_auth_token(),
+  auth_sas = NULL
+) {
+  tryCatch(
+    AzureStor::storage_endpoint(endpoint,
+                                key = auth_key,
+                                token = auth_token,
+                                sas = auth_sas) |>
+      AzureStor::storage_container(name = bucket) |>
+      AzureStor::get_storage_properties(key),
+    http_400 = function(condition) NULL
+  )
+}
+
+# TODO: implement "version" optional argument
+azure_exists <- function(
+  key,
+  bucket,
+  endpoint,
+  version = NULL,
+  auth_key = NULL,
+  auth_token = azure_auth_token(),
+  auth_sas = NULL
+) {
+  AzureStor::storage_endpoint(endpoint,
+                              key = auth_key,
+                              token = auth_token,
+                              sas = auth_sas) |>
+    AzureStor::storage_container(name = bucket) |>
+    AzureStor::storage_file_exists(key)
+}
+
+azure_list_etags <- function(
+  prefix = NULL,
+  bucket,
+  endpoint,
+  auth_key = NULL,
+  auth_token = azure_auth_token(),
+  auth_sas = NULL
+) {
+  if (stringr::str_trim(prefix) == "") {
+    prefix <- NULL
+  }
+  container <- AzureStor::storage_endpoint(endpoint,
+                                           key = auth_key,
+                                           token = auth_token,
+                                           sas = auth_sas) |>
+    AzureStor::storage_container(name = bucket)
+  files <- container |>
+    AzureStor::list_storage_files() |>
+    tibble::as_tibble()
+  if (nrow(files) > 0) {
+    files <- dplyr::filter(files, !isdir)
+    if (!is.null(prefix)) {
+      files <- files |>
+        dplyr::filter(stringr::str_starts(fs::path_file(name), prefix))
+    }
+    if (nrow(files) > 0) {
+      files$name |>
+        purrr::map(\(x) AzureStor::get_storage_properties(container, x)$etag) |>
+        stats::setNames(files$name)
+    } else {
+      list()
+    }
+  } else {
+    list()
+  }
+}
+
+# TODO: implement "version" optional argument
+azure_download <- function(
+  file,
+  key,
+  bucket,
+  endpoint,
+  version = NULL,
+  auth_key = NULL,
+  auth_token = azure_auth_token(),
+  auth_sas = NULL
+) {
+  fs::path_dir(file) |>
+    fs::dir_create()
+  AzureStor::storage_endpoint(endpoint,
+                              key = auth_key,
+                              token = auth_token,
+                              sas = auth_sas) |>
+    AzureStor::storage_container(name = bucket) |>
+    AzureStor::storage_download(src = key, dest = file, overwrite = TRUE)
+}
+
+# TODO: implement "version" optional argument
+azure_delete <- function(
+  key,
+  bucket,
+  endpoint,
+  version = NULL,
+  auth_key = NULL,
+  auth_token = azure_auth_token(),
+  auth_sas = NULL
+) {
+  AzureStor::storage_endpoint(endpoint,
+                              key = auth_key,
+                              token = auth_token,
+                              sas = auth_sas) |>
+    AzureStor::storage_container(name = bucket) |>
+    AzureStor::delete_storage_file(file = key, confirm = FALSE)
+  invisible()
+}
+
+# TODO: implement "metadata" optional argument
+azure_upload <- function(
+  file,
+  key,
+  bucket,
+  endpoint,
+  metadata = list(),
+  auth_key = NULL,
+  auth_token = azure_auth_token(),
+  auth_sas = NULL
+) {
+  AzureStor::storage_endpoint(endpoint,
+                              key = auth_key,
+                              token = auth_token,
+                              sas = auth_sas) |>
+    AzureStor::storage_container(name = bucket) |>
+    AzureStor::storage_upload(src = file, dest = key)
+}
+
+azure_auth_token <- function(
+  resource = "https://storage.azure.com",
+  tenant = "common",
+  app = NULL,
+  auth_type = "device_code"
+) {
+  tryCatch(
+    AzureAuth::get_managed_token(resource),
+    error = function(err) {
+      if (is.null(app)) {
+        app <- try(AzureRMR::get_azure_login()$token$client$client_id,
+                   silent = TRUE)
+        if (inherits(app, "try-error")) {
+          AzureRMR::create_azure_login()
+          app <- AzureRMR::get_azure_login()$token$client$client_id
+        }
+      }
+      tokens <- AzureRMR::list_azure_tokens()
+      resources <- purrr::map(tokens, \(x) x$resource)
+      token_use <- match(resource, resources)[1]
+      if (!is.na(token_use)) {
+        tokens[[token_use]]
+      } else {
+        AzureRMR::get_azure_token(resource,
+                                  tenant = tenant,
+                                  app = app,
+                                  auth_type = auth_type)
+      }
+    }
+  )
+}
+# nocov end