rshinyserver-sideshinyapps

Is it possible to make changes to a local file from a server-side R Shiny app?


Problem

I am making an app that allows people to add data to a csv file. To avoid my co-workers seeing any code, I want this app to be server-side, e.g. on shinyapps.io. Currently, I have tried fileinput() and shinyFiles: these work when my app is on my local PC (see MWEs), but not when I have deployed it to shinyapps.io.

Can this ever work, or will there always be problems with writing to local directories from a server?

MWE for fileinput()

library(shiny)
library(shinyWidgets)
library(dplyr) # For bind_rows

# Define UI
ui = fluidPage(
    fileInput("my_file", "Add to Master Sheet", accept = ".csv"), # File upload
    actionButton("submit_btn", "Submit data") # Submit button
)

# Define Server Logic
server = function(input, output) {
    observeEvent(input$submit_btn, {
        my_data = read.csv(input$my_file$datapath) # Read in my data
        my_new_data = bind_rows(my_data, data.frame(5)) # Add new data
        write.csv(my_new_data, input$my_file$name) # Write the updated file
        stopApp() # Close app
    })
    
}

# Run the application
shinyApp(ui, server)

This example works when the app is on my local machine, but even then it only saves the new .csv file to the same location as the app. Using input$my_file$datapath does not work. When the app is on shinyapps.io, no file is updated.

MWE for shinyFiles()

library(shiny)
library(shinyFiles)
library(shinyWidgets)
library(dplyr)

# Define UI
ui = fluidPage(
    shinyFilesButton("file_upload", "Choose a CSV file", title = "Upload", multiple = FALSE),
    verbatimTextOutput("file_status", placeholder = TRUE),  # Placeholder text will be shown until a file is uploaded
    actionButton("submit_btn", "Submit data"),
)

server <- function(input, output, session) {
    
    volumes <- c(Home = fs::path_home(), "R Installation" = R.home(), getVolumes()())
    shinyFileChoose(input, "file_upload", roots = volumes, filetypes = c('', 'csv'), session = session)
    observe({
        if (!is.null(input$file_upload)) {
            file_info <- parseFilePaths(volumes, input$file_upload)
            output$file_status <- renderText(paste("Selected file:", file_info$name))
        }
    })

    observeEvent(input$submit_btn, {
        infile = parseFilePaths(volumes, input$file_upload)
        my_data = read.csv(infile$datapath) # Read in my data
        my_new_data = bind_rows(my_data, data.frame(5)) # Add new data
        write.csv(my_new_data, infile$datapath) # Write the updated file
        stopApp() # Close app
    })
}

shinyApp(ui, server)

Again this works when on my local PC, but on shinyapps.io, most of my system's files are not shown when I click 'file upload'.


Solution

  • The notion that the server would have access to the user's local filesystem/drive is counter to most security postures, and even if the server supported it, most browsers will not (should not!) allow it. Instead, have the user upload their data (one or more files), you do something to it (perhaps interactively), and then have them download the results.

    Data setup:

    write.csv(mtcars, "mt.csv", row.names=FALSE)
    

    From here, a simple app:

    library(shiny)
    ui <- fluidPage(
      shinyjs::useShinyjs(),  # Set up shinyjs
      titlePanel("Hello Shiny!"),
      sidebarLayout(
        sidebarPanel(
          fileInput("infile", "Upload something!"),
          actionButton("act", "Do something to it!"),
          downloadButton("dwnld", "Get it back!")
        ),
        mainPanel(
          DT::DTOutput("tbl")
        )
      )
    )
    server <- function(input, output, session) {
      shinyjs::disable("act")
      shinyjs::disable("dwnld")
      userdata <- reactiveVal(NULL)
      observeEvent(input$infile, {
        req(file.exists(input$infile$datapath))
        tmp <- tryCatch(
          read.csv(input$infile$datapath),
          error = function(e) e)
        validate(
          need(!inherits(tmp, "error"), "Error reading file")
        )
        shinyjs::enable("act")
        shinyjs::enable("dwnld")
        userdata(tmp)
      })
      observeEvent(input$act, {
        req(userdata())
        dat <- userdata()
        dat[[1]] <- dat[[1]] + 100
        userdata(dat)
      })
      output$tbl <- DT::renderDT({
        req(userdata())
      })
      output$dwnld <- downloadHandler(
        filename = function() {
          sprintf("%s_updated_%s.csv", tools::file_path_sans_ext(input$infile$name),
                  format(Sys.Date(), format = "%Y%m%d"))
        },
        content = function(file) {
          write.csv(userdata(), file, row.names = FALSE)
        }
      )
    }
    shinyApp(ui, server)
    

    I'm using shinyjs solely to disable the "do something" and "download" buttons; not required, but I find interfaces that suggest I can download something before uploading something might have problems.

    From here, we start with:

    shiny, start

    Click on "Browse" and upload our mt.csv from above,

    shiny, data uploaded

    I clicked the "do something" several times (this is just for show here, not strictly required), note that mpg is increased:

    shiny, something done

    Click, the Get it back! download button and you'll have a new filename. I go through some effort to rename the file "smartly", you can name it however you want.