Skip to content

Conversation

@roman-polak
Copy link
Collaborator

@roman-polak roman-polak commented Nov 23, 2025

As part of folder permissions project, this PR introduces project secret handling into DataMart API.
The handling consists of the following.

  1. Getting project secret value from the environment or from document.token parameter.
  2. Passing the project secret to Site DataMart endpoints in X-Q-Project-Secret HTTP header.

The project secret value is used in Site to authorize access to DataMart files.

A note on naming: internally, Displayr Document is called Project and Uploaded Office document is called Document. In user facing UI/text/code Displayr Document is called document. This is why public API parameters introduced in this PR are named document.token rather than project.token.

@roman-polak roman-polak marked this pull request as ready for review November 26, 2025 03:32
#'
#' @export
QFileExists <- function(filename, show.warning = TRUE)
QFileExists <- function(filename, show.warning = TRUE, company.token = NA, document.token = NA)
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

A company secret provided in a parameter is considered to be of "another company", assuming the calling code runs in Displayr environment where "this" company's secret is set as a global companySecret value.
Not allowing to provide a company secret as a parameter to QFileExists was to prevent snooping in other companies' Cloud Drives (even if the caller knew the other companies' secret tokens). This was not really preventing the snooping, but merely made it slightly less convenient.

With the need to provide project secret in document.token parameter it makes little sense to keep leaving out company secret. Since allowing to specify company.token does not reduce security in any way, it is now an officially supported parameter for QFileExists.

R/DataMart.R Outdated
Comment on lines 517 to 523
if (secret == "") {
secret <- tryCatch({
val <- .GlobalEnv$userSecrets$projectSecret
if (is.character(val) && nzchar(val)) val else ""
},
error = function(e) "")
}
Copy link
Collaborator Author

@roman-polak roman-polak Nov 26, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is a temporary shortcut that makes possible to work with the modified flipAPI sooner, i.e. without the need to wait for an updated R server to be deployed.
One we make the necessary change in R server, this can be removed.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This swallows errors. Is this intended? I'm not following the temporary shortcut argument? You can work with flipAPI sooner before a separate R server update?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The idea of the shortcut is demonstrated in the screenshot above.

As you can see .GlobalEnv$userSecrets$projectSecret carries a value of a Guid. This value is set for every RItem in a Displayr Document here. R server already knows to pass company secret and user secrets into the global environment, but not project secret. Since user secrets is very generic by definition, I piggyback on it to pass a secret named projectSecret into flipAPI.
My thought about the shortcut was that it would be possible for flipAPI to get the secret from R server through user secrets. I now realize that if flipAPI is not installed in a running R server dynamically, the shortcut won't work.

Do you know whether flipAPI is bundled in R server image or is it installed dynamically?
Would install.packages() in an RItem work to install a newer package version?


with_mocked_bindings(
code = {
with_mocked_bindings(
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

with_mocked_bindings can only handle mocking in one package at a time, hence the nesting of with_mocked_bindings.

#'
#' @export
QDeleteFiles <- function(filenames, company.token = getCompanySecret())
QDeleteFiles <- function(filenames, company.token = getCompanySecret(), document.token = getProjectSecret())
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

To keep the API and the implementation in the back end simple, we only require a single project secret that should grant access to all files specified in filenames. Users will always be able to split calls if that won't be the case for their files.
Detailed documentation for that will be provided later, when we're ready to go public with this.

R/DataMart.R Outdated
#' @param method character string. See documentation for connections.
#' @param mime.type character string. The mime-type of this file. If not provided, it will be interpreted from the file extension.
#' @param company.token Use this if you need to read from a different company's Displayr Cloud Drive. You need to contact Support to get this token.
#' @param document.token Reserved
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I know this package does it a lot but you can use the following

#' @inheritParams <other_function>

and it'll inherit the parameter documentation so you don't need to repeat it.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

TIL

R/DataMart.R Outdated
Comment on lines 517 to 523
if (secret == "") {
secret <- tryCatch({
val <- .GlobalEnv$userSecrets$projectSecret
if (is.character(val) && nzchar(val)) val else ""
},
error = function(e) "")
}
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This swallows errors. Is this intended? I'm not following the temporary shortcut argument? You can work with flipAPI sooner before a separate R server update?

@@ -0,0 +1,154 @@
library(testthat)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

There is no need to load testthat in a test file.

@@ -0,0 +1,154 @@
library(testthat)
library(httr)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Loading httr is only required here if you are using functions in the test file that aren't already imported in the NAMESPACE file.

companySecretHeader <- ifelse(is.null(companySecretHeader), "", companySecretHeader)

if (expect_header_to_be_equivalent_to_company_secret && (companySecretHeader != companySecret)) {
test_env$headersVerificatoinResult <- list(asExpected = FALSE,
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

small typo Verification

QDeleteFiles(c("Test1.dat", "Test2.dat")),
QDeleteFiles(c("Test1.dat", "Test2.dat"), company.token = companyTokenParameter))

expect_true(test_env$headersVerificatoinResult$asExpected, info = test_env$headersVerificatoinResult$message)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The info arg is soft deprecated. Did you intent to use it?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Same as before, will rework this to not use info.

QFileExists("Test.dat", show.warning = FALSE),
QFileExists("Test.dat", show.warning = FALSE, company.token = companyTokenParameter))

expect_true(test_env$headersVerificatoinResult$asExpected, info = test_env$headersVerificatoinResult$message)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

info is soft depcrated and doesn't seem to be used?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is me using it. test_env$headersVerificatoinResult$message is set in verifyHttpHeaders and describes what exactly failed during verification.
But I can rework this to not use info.

Comment on lines 67 to 74
orig_close_connection <- close.connection
orig_file_exists <- file.exists
on.exit({
close.connection <- orig_close_connection
file.exists <- orig_file_exists
}, add = TRUE)
close.connection <- NULL
file.exists <- NULL
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is this needed? The close.connection and file.exists are already mocked below?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is needed for reasons described here.
I think I did see R CMD CHECK failing in CI without this. Otherwise I wouldn't know this is needed.

I will add a comment explaining why it's needed.

R/DataMart.R Outdated
#' @noRd
getProjectSecret <- function()
{
secret <- get0("projectSecret", ifnotfound = "")
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is this defined in the .GlobalEnv? If so, it should be specified with the envir arg.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It is defined in .GlobalEnv, just like "companySecret" above. I followed the pattern in getCompanySecret.

When the package is used in a Displayr RItem, packageSecret will be set by R server similar to how companySecret is set. I don't know yet how exactly it is done in R server, only know that it happens (this is what I found so far). So, if envir should be specified here, it should also be specified for companySecret.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I suspect that the variables should be defined in the global environment and the get0 function doesn't look there first, by coincidence there is nothing else defined with that name in other scopes so it eventually finds it. So, fair enough.

R/DataMart.R Outdated
Comment on lines 517 to 521
if (secret == "") {
secret <- tryCatch({
val <- .GlobalEnv$userSecrets$projectSecret
if (is.character(val) && nzchar(val)) val else ""
},
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Instead of this could use the null coalescing operator? The entire function could be this one line? Avoids the ugly try catch too.

get0("projectSecret", ifnotfound = NULL, envir = .GlobalEnv) %||%
    get0("userSecrets", mode = "list", ifnotfound = NULL, envir = .GlobalEnv)[["projectSecret"]] %||%
    ""

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

admittedly it wont catch the case when.GlobalEnv$userSecrets$projectSecret is not a single string though but that seems pretty unlikely?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Agree, this is much nicer. If we set .GlobalEnv$userSecrets$projectSecret , then it is a single string.
It can be tampered with by user, like this
Image

, but that will be the user shooting himself in the foot. Not something I'd worry about.

R/DataMart.R Outdated
#' @param mime.type character string. The mime-type of this file. If not provided, it will be interpreted from the file extension.
#' @param company.token Use this if you need to read from a different company's Displayr Cloud Drive. You need to contact Support to get this token.
#' @param document.token Reserved
#' @inheritParams QFileExists params = c("document.token")
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't think the params = c(... part is required. It'll resolve any params that aren't already defined in the block if I recall correctly?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You're right. I didn't expect it to be that smart, but it is.

@roman-polak
Copy link
Collaborator Author

@jrwishart , I've addressed all your previous comments and while doing that also found some bugs. Those are fixed now. Please review when convenient.

R/DataMart.R Outdated
return (secret)
}

#' Gets document secret from the environment. Throws an error if not found.
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It wont throw an error if not found. It'll return ""

Comment on lines 8 to 11
companySecretHeader = headers["X-Q-Company-Secret"];
companySecretHeader <- ifelse(is.null(companySecretHeader), "", companySecretHeader)
projectSecretHeader = headers["X-Q-Project-Secret"];
projectSecretHeader <- ifelse(is.null(projectSecretHeader), "", projectSecretHeader)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Some more null coalescing will make this easier to read in my opinion.

Suggested change
companySecretHeader = headers["X-Q-Company-Secret"];
companySecretHeader <- ifelse(is.null(companySecretHeader), "", companySecretHeader)
projectSecretHeader = headers["X-Q-Project-Secret"];
projectSecretHeader <- ifelse(is.null(projectSecretHeader), "", projectSecretHeader)
companySecretHeader <- headers["X-Q-Company-Secret"] %||% ""
projectSecretHeader <- headers["X-Q-Project-Secret"] %||% ""

minor nit: ; not required in R and generally not used as end of line char.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Some more null coalescing will make this easier to read in my opinion.

I agree.
I also checked what headers actually is in terms of type/structure. Running str(headers) gives this

Named chr [1:3] "some_token" "some_project_token" "1027046"
 - attr(*, "names")= chr [1:3] "X-Q-Company-Secret" "X-Q-Project-Secret" "X-Q-Project-ID"

Copilot says to use double brackets to achieve what I want, i.e. companySecretHeader = headers[["X-Q-Company-Secret"]] %||% "", and to change the default value of headers to character(0).

minor nit: ; not required in R and generally not used as end of line char.

Oh, yes. Thanks. This is my muscle memory from 3 other languages that all require ;

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah if headers is a list then it will return a list if using a single [] pair. The data type is reduced if the double [[]] pair is used. e.g.

> x <- list(foo = 1, bar = 2)
> x["foo"] |> str()
List of 1
 $ foo: num 1
> x[["foo"]] |> str()
 num 1
``

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If headers is a character vector instead of a list then the named element lookup will fail. e.g.

> x <- setNames(1:3, letters[1:3])
> x
a b c 
1 2 3 
> x[["d"]]
Error in x[["d"]] : subscript out of bounds
> x["d"]
<NA> 
  NA

I recall headers being a list so it avoids that hiccup. Well it is in flipAI, not sure in this repo.

} else {
expect_true(TRUE)
}
}
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is a new pattern. I suspect you wanted this as it gives more detail in the output if things go bad than expect_equal(foo, bar) provides normally?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, the default output for expect_equal or expect_true is not clear and detailed enough. That's why I was using info parameter, but since that is deprecated, using fail gives full control over the message.

Copy link
Contributor

@jrwishart jrwishart left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Some minor nit comments but looks good, although unusual looking tests for me 😅

@roman-polak roman-polak merged commit b04c0cf into master Dec 3, 2025
3 of 5 checks passed
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Labels

None yet

Projects

None yet

Development

Successfully merging this pull request may close these issues.

3 participants