From aa10f12fce59d6c5cdd32f9b2fa933a50125fbd6 Mon Sep 17 00:00:00 2001
From: zerweck <zerweck@users.noreply.github.com>
Date: Tue, 6 Aug 2019 14:47:35 +0200
Subject: [PATCH] Fix: Option to set maximum expiry date for task completion
 upload tokens

#363
---
 R/batch-api.R       |  6 ++++--
 R/doAzureParallel.R | 14 +++++++++++---
 2 files changed, 15 insertions(+), 5 deletions(-)

diff --git a/R/batch-api.R b/R/batch-api.R
index 7d7f8de3..ff96c204 100644
--- a/R/batch-api.R
+++ b/R/batch-api.R
@@ -16,6 +16,7 @@ BatchUtilities <- R6::R6Class(
       cloudCombine <- args$cloudCombine
       userOutputFiles <- args$outputFiles
       containerImage <- args$containerImage
+      maxDate <- args$maxDate
 
       accountName <- storageClient$authentication$name
 
@@ -76,7 +77,7 @@ BatchUtilities <- R6::R6Class(
         rAzureBatch::createBlobUrl(
           storageAccount = storageClient$authentication$name,
           containerName = jobId,
-          sasToken = storageClient$generateSasToken("w", "c", jobId),
+          sasToken = storageClient$generateSasToken("w", "c", jobId, end = maxDate),
           storageEndpointSuffix = config$endpointSuffix
         )
 
@@ -109,13 +110,14 @@ BatchUtilities <- R6::R6Class(
 
       outputFiles <- append(outputFiles, userOutputFiles)
 
+
       commands <-
         c(commands,
           rCommand)
 
       commands <- linuxWrapCommands(commands)
 
-      sasToken <- storageClient$generateSasToken("rwcl", "c", jobId)
+      sasToken <- storageClient$generateSasToken("rwcl", "c", jobId, end = maxDate)
       queryParameterUrl <- "?"
 
       for (query in names(sasToken)) {
diff --git a/R/doAzureParallel.R b/R/doAzureParallel.R
index aedf7da4..bf6a278a 100644
--- a/R/doAzureParallel.R
+++ b/R/doAzureParallel.R
@@ -557,11 +557,17 @@ setHttpTraffic <- function(value = FALSE) {
 
   job <- batchClient$jobOperations$getJob(id)
 
+  if(!is.null(obj$options$azure$maxDate)) {
+    maxDate <- obj$options$azure$maxDate
+  } else {
+    maxDate <- Sys.time() + 60 * 60 * 24 * 2 # same as default value for rAzureBatch::StorageServiceClient$public_methods$generateSasToken
+  }
+
   outputContainerUrl <-
     rAzureBatch::createBlobUrl(
       storageAccount = storageClient$authentication$name,
       containerName = id,
-      sasToken = storageClient$generateSasToken("w", "c", id),
+      sasToken = storageClient$generateSasToken("w", "c", id, end = maxDate),
       storageEndpointSuffix = config$endpointSuffix
     )
 
@@ -641,7 +647,8 @@ setHttpTraffic <- function(value = FALSE) {
       outputFiles = mergeOutput,
       containerImage = data$containerImage,
       args = args,
-      maxRetryCount = maxTaskRetryCount
+      maxRetryCount = maxTaskRetryCount,
+      maxDate = maxDate
     )
 
     cat("\r", sprintf("Submitting tasks (%s/%s)", i, length(endIndices)), sep = "")
@@ -700,7 +707,8 @@ setHttpTraffic <- function(value = FALSE) {
       cloudCombine = cloudCombine,
       outputFiles = append(obj$options$azure$outputFiles, mergeOutput),
       containerImage = data$containerImage,
-      resourceFiles = mergeResources
+      resourceFiles = mergeResources,
+      maxDate = maxDate
     )
 
     cat(". . .")