Reputation: 310
I built a (complex) shiny app. The user uploads some data, creates plots, does some time consuming calculations, etc.
All necessary data will be stored in a model object model
(R6). In order to continue the work in the future, the user can download this model object (with saveRDS
) and upload it again whenever he wants.
The drawback: Since the whole R6 model object model
will be saved you could easily load it with readRDS
and read the whole code structure of the model object. This isn't the result I wanted, but it's still acceptable.
The other point is more about a security question: Someone could change the code of the model
object and upload it. Is it possible to write some piece of R code that would be critical to the server?
To avoid this drawback, I encrypt the model with "cyphr" before saving it with saveRDS
. But in this case the file is much bigger! And that's not an acceptable solution.
Are there good ways for saving a shiny state / apps, or encrypt the object in a "light version"?
The following example could be used for saving and uploading (modified) R6 object.
library(shiny)
library(R6)
server <- function(input, output, session) {
test_object <- Test_object$new()
output$download <- downloadHandler(
filename = "test.tst",
content = function(file) {
saveRDS(test_object, file = file)
},
contentType = "TST/tst"
)
observeEvent(input$upload, ignoreInit = T, {
test_object <<- readRDS(input$upload$datapath)
#print id
print(test_object$id)
})
observeEvent(input$print, ignoreInit = T, {
test_object$call_function()
})
}
ui <- function(request) {
fluidPage(
downloadButton("download"),
fileInput("upload", "upload", accept = "tst"),
actionButton("print","print")
)
}
#R6 object
Test_object <- R6Class(classname = "Test_object", lock_objects = T,
public = list(
id = "5",
# Change the content of this list with some critical code
# after reading the test.tst in r with readRDS(), save it with saveRDS and upload it
list = list("Hi", " there!"),
call_function = function(){
print(self$list)
}
)
)
shinyApp(ui = ui, server = server)
Update:
To avoid the security lack that someone could modified the model, I use a SHA256 checksum. Each saved model get an unique ID. The ID and the hash of the corresponding object will be saved in a database.
Something like this:
library(digest)
#R6 object
Test_object <- R6Class(classname = "Test_object", lock_objects = T,
public = list(
id = NULL,
list = list("Hi", " there!"),
call_function = function(){
print(self$list)
}
)
)
## Datebase
database <- list(id = c(0), hash = c(0))
# Object to be saved
new_object <- Test_object$new()
# get next id from db
next_id <- max(database$id) + 1
# set next_id to model
new_object$id <- next_id
# get sha of this object
sha <- digest(new_object, algo = "sha256")
# add id and sha to databse
database$id[length(database$id)+1] <- next_id
database$hash[length(database$hash)+1] <- sha
# write object
saveRDS(new_object, "object.abc")
# If someone uploads this file
uploaded_object <- readRDS("object.abc")
# get id
uploaded_id <- uploaded_object$id
# create sha again
uploaded_sha <- digest(uploaded_object, algo = "sha256")
# compare shas
sha_database <- database$hash[match(uploaded_id, database$id)]
if(uploaded_sha == sha_database) print("Uploaded object is valid!")
Upvotes: 4
Views: 302
Reputation: 310
Encrypting the RDS file instead of the model object leads to a file that has similar size to the RDS file without encryption. (Using the package 'cyphr')
file = "test_object.abc"
saveRDS(test_object , file = file)
cyphr_key <- cyphr::key_openssl(openssl::aes_keygen())
cyphr::encrypt_file(file, dest = file, key = cyphr_key)
But I would recommend to use both a checksum and the encryption.
Upvotes: 1