PS-1576: Add new QGetSharedUrl method

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: flipAPI
 Type: Package
 Title: Web APIs tools
-Version: 1.6.5
+Version: 1.6.6
 Author: Displayr <opensource@displayr.com>
 Maintainer: Displayr <opensource@displayr.com>
 Description: Functions to extract data and interact with web APIs.

R/DataMart.R

@@ -380,6 +380,52 @@ QSaveData <- function(object, filename, compression.file.size.threshold = NULL,
     }
 }
 
+#' Share an object
+#'
+#' 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.
+#'
+#' @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 content
+#' @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("X-Q-Company-Secret" = company.secret,
+                                     "X-Q-Project-Secret" = project.secret,
+                                     "X-Q-Project-ID" = client.id),
+                encode = "raw"))
+    has.errored <- inherits(res, "try-error")
+
+    if (res$status_code == 404)
+    {
+        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("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
+    content$sharingUrl
+}
+
 #' Deletes a set of objects
 #'
 #' Deletes a list of objects by filename from the Displayr cloud drive

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")