From 89ef8d647bc20a60d6ae16d42a1583808d15fcb8 Mon Sep 17 00:00:00 2001 From: Braedon Wooding Date: Wed, 28 Jan 2026 17:12:47 +1100 Subject: [PATCH 1/4] Expose new API to share a file in datamart --- R/DataMart.R | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/R/DataMart.R b/R/DataMart.R index 121e5e1..2ab8a5f 100644 --- a/R/DataMart.R +++ b/R/DataMart.R @@ -380,6 +380,56 @@ QSaveData <- function(object, filename, compression.file.size.threshold = NULL, } } +#' Share an object +#' +#' Get's the cloud drive share url for an object saved to the Displayr Cloud Drive. +#' +#' If the file has not previously been shared it will be shared else the already existing +#' share url will be returned. +#' +#' @param filename character string. Name of the file that is being shared. +#' To reference a file in a subdirectory, use double backslashes after each folder (e.g "subdir\\file.csv"). +#' +#' @importFrom httr POST add_headers upload_file +#' @importFrom utils URLencode +#' @return Share URL as a string +#' @importFrom flipU StopForUserError +#' @export +QGetSharedUrl <- function(filename) +{ + company.secret <- getCompanySecret() + project.secret <- getProjectSecret() + client.id <- getClientId() + api.root <- getApiRoot("DataMart/Share") + res <- try(POST(paste0(api.root, "?filename=", URLencode(filename, TRUE)), + config = add_headers("Content-Type" = guess_type(filename), + "X-Q-Company-Secret" = company.secret, + "X-Q-Project-Secret" = project.secret, + "X-Q-Project-ID" = client.id), + encode = "raw", + body = upload_file(tmpfile))) + has.errored <- inherits(res, "try-error") + + if (!has.errored && res$status_code == 413) # 413 comes from IIS when we violate its web.config limits + stopBadRequest(res, "Could not write to Displayr Cloud Drive. Data to write is too large.") + else if (!has.errored && res$status_code == 404) + { + stop("QSaveData has encountered an unknown error. ", + "404: No such file exists. ", + "The likely cause was an incorrect path preceding the filename, or insufficient access to the file path.") + } + else if (has.errored || res$status_code != 200) + { + warning("QSaveData has encountered an unknown error.") + stopBadRequest(res, "Could not share file.") + } + + content <- httr::content(res) + # The content returns a JSON object with the share url in the 'sharingUrl' field + # and a boolean (that we ignore) that indicates if the file was newly shared or not + return (content$sharingUrl) +} + #' Deletes a set of objects #' #' Deletes a list of objects by filename from the Displayr cloud drive From ea7def8ec6d575a40fd53990a64afcec972f5551 Mon Sep 17 00:00:00 2001 From: Braedon Wooding Date: Thu, 29 Jan 2026 14:12:25 +1100 Subject: [PATCH 2/4] Fix route --- R/DataMart.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/DataMart.R b/R/DataMart.R index 2ab8a5f..8e68040 100644 --- a/R/DataMart.R +++ b/R/DataMart.R @@ -402,12 +402,10 @@ QGetSharedUrl <- function(filename) client.id <- getClientId() api.root <- getApiRoot("DataMart/Share") res <- try(POST(paste0(api.root, "?filename=", URLencode(filename, TRUE)), - config = add_headers("Content-Type" = guess_type(filename), - "X-Q-Company-Secret" = company.secret, + config = add_headers("X-Q-Company-Secret" = company.secret, "X-Q-Project-Secret" = project.secret, "X-Q-Project-ID" = client.id), - encode = "raw", - body = upload_file(tmpfile))) + encode = "raw")) has.errored <- inherits(res, "try-error") if (!has.errored && res$status_code == 413) # 413 comes from IIS when we violate its web.config limits From d593bed844686bb314122c49cc65a4c9812b07a2 Mon Sep 17 00:00:00 2001 From: Braedon Wooding Date: Thu, 29 Jan 2026 14:29:46 +1100 Subject: [PATCH 3/4] Fixes --- R/DataMart.R | 14 +++++----- tests/testthat/test-datamart.R | 49 ++++++++++++++++++++++++++++++++++ 2 files changed, 55 insertions(+), 8 deletions(-) diff --git a/R/DataMart.R b/R/DataMart.R index 8e68040..16bb293 100644 --- a/R/DataMart.R +++ b/R/DataMart.R @@ -382,7 +382,7 @@ QSaveData <- function(object, filename, compression.file.size.threshold = NULL, #' Share an object #' -#' Get's the cloud drive share url for an object saved to the Displayr Cloud Drive. +#' Gets the cloud drive share url for an object saved to the Displayr Cloud Drive. #' #' If the file has not previously been shared it will be shared else the already existing #' share url will be returned. @@ -390,7 +390,7 @@ QSaveData <- function(object, filename, compression.file.size.threshold = NULL, #' @param filename character string. Name of the file that is being shared. #' To reference a file in a subdirectory, use double backslashes after each folder (e.g "subdir\\file.csv"). #' -#' @importFrom httr POST add_headers upload_file +#' @importFrom httr POST add_headers content #' @importFrom utils URLencode #' @return Share URL as a string #' @importFrom flipU StopForUserError @@ -408,24 +408,22 @@ QGetSharedUrl <- function(filename) encode = "raw")) has.errored <- inherits(res, "try-error") - if (!has.errored && res$status_code == 413) # 413 comes from IIS when we violate its web.config limits - stopBadRequest(res, "Could not write to Displayr Cloud Drive. Data to write is too large.") - else if (!has.errored && res$status_code == 404) + if (res$status_code == 404) { - stop("QSaveData has encountered an unknown error. ", + stop("QGetSharedUrl has encountered an unknown error. ", "404: No such file exists. ", "The likely cause was an incorrect path preceding the filename, or insufficient access to the file path.") } else if (has.errored || res$status_code != 200) { - warning("QSaveData has encountered an unknown error.") + warning("QGetSharedUrl has encountered an unknown error.") stopBadRequest(res, "Could not share file.") } content <- httr::content(res) # The content returns a JSON object with the share url in the 'sharingUrl' field # and a boolean (that we ignore) that indicates if the file was newly shared or not - return (content$sharingUrl) + content$sharingUrl } #' Deletes a set of objects diff --git a/tests/testthat/test-datamart.R b/tests/testthat/test-datamart.R index b8bdaf6..1fb0182 100644 --- a/tests/testthat/test-datamart.R +++ b/tests/testthat/test-datamart.R @@ -151,6 +151,55 @@ test_that("DS-3269: Data Mart unavailable", }) }) +test_that("QGetSharedUrl", { + skip_if(!nzchar(companySecret), "Not in test environment or no company set up") + + # First save a file to share + expect_invisible(QSaveData(mtcars, "mtcars_share_test.rds")) + expect_true(QFileExists("mtcars_share_test.rds")) + + # Get the shared URL + shared.url <- QGetSharedUrl("mtcars_share_test.rds") + expect_true(is.character(shared.url)) + expect_true(nzchar(shared.url)) + + # Calling again should return the same URL (idempotent) + shared.url.again <- QGetSharedUrl("mtcars_share_test.rds") + expect_equal(shared.url, shared.url.again) + + # Clean up + expect_invisible(QDeleteFiles("mtcars_share_test.rds")) +}) + +test_that("QGetSharedUrl: bad cases", { + skip_if(!nzchar(companySecret), "Not in test environment or no company set up") + + # Non-existent file should return 404 error + expect_error( + QGetSharedUrl("file_that_does_not_exist.rds"), + "404: No such file exists" + ) + + # 404 error with mocked POST + mocked.post <- function(...) { + list(status_code = 404) + } + with_mocked_bindings( + POST = mocked.post, + QGetSharedUrl("any_file.rds"), + .package = "httr" + ) |> + expect_error( + paste0( + "QGetSharedUrl has encountered an unknown error. ", + "404: No such file exists. ", + "The likely cause was an incorrect path preceding the filename, ", + "or insufficient access to the file path." + ), + fixed = TRUE + ) +}) + test_that("Delete Data", { skip_if(!nzchar(companySecret), "Not in test environment or no company set up") From b725d50b1e3e4aa3662b6d48c145a2aebdcb0162 Mon Sep 17 00:00:00 2001 From: Braedon Wooding Date: Thu, 29 Jan 2026 15:34:01 +1100 Subject: [PATCH 4/4] Bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e4b5078..1de4e02 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: flipAPI Type: Package Title: Web APIs tools -Version: 1.6.5 +Version: 1.6.6 Author: Displayr Maintainer: Displayr Description: Functions to extract data and interact with web APIs.