File uploads and downloads

Lesson 7 — R Shiny

Lesson 7 of 11 Intermediate ~70 min

Learning objectives

  • Accept file uploads safely and validate them before use
  • Handle multiple files and different formats in one handler
  • Generate downloads: CSV, Excel, RTF, PDF and zip archives
  • Render a parameterised report from within an app
  • Understand the security implications of user-supplied files

Uploading

ui <- fluidPage(
  fileInput("file", "Upload dataset",
            accept   = c(".csv", ".sas7bdat", ".xpt", ".xlsx"),
            multiple = FALSE,
            buttonLabel = "Browse...",
            placeholder = "No file selected")
)

input$file is a data frame, one row per file:

observeEvent(input$file, {
  str(input$file)
#> 'data.frame': 1 obs. of 4 variables:
#>  $ name    : chr "adsl.csv"                  original filename
#>  $ size    : int 245678                      bytes
#>  $ type    : chr "text/csv"                  MIME type from the browser
#>  $ datapath: chr "/tmp/RtmpXXXX/0.csv"       where Shiny put it
})
Warningdatapath is temporary and renamed

Shiny writes uploads to a temporary directory with a numbered name — the original extension may not be preserved on all platforms. Two consequences:

  • Determine the format from input$file$name, not datapath
  • Copy the file if you need it after the reactive finishes; the temp directory is cleaned up when the session ends

Reading by extension

library(tools)

uploaded <- reactive({
  req(input$file)

  ext <- tolower(file_ext(input$file$name))

  switch(ext,
    csv      = readr::read_csv(input$file$datapath, show_col_types = FALSE),
    tsv      = readr::read_tsv(input$file$datapath, show_col_types = FALSE),
    txt      = readr::read_delim(input$file$datapath, show_col_types = FALSE),
    xlsx     = readxl::read_excel(input$file$datapath),
    xls      = readxl::read_excel(input$file$datapath),
    sas7bdat = haven::read_sas(input$file$datapath),
    xpt      = haven::read_xpt(input$file$datapath),
    rds      = readRDS(input$file$datapath),
    validate(paste0("Unsupported file type: .", ext))
  )
})

Validating uploads

Never trust an uploaded file. Check size, type and contents before doing anything with it.

# Global: cap the upload size (default is 5 MB)
options(shiny.maxRequestSize = 100 * 1024^2)   # 100 MB

uploaded <- reactive({
  req(input$file)

  # 1. Size
  validate(need(
    input$file$size < 100 * 1024^2,
    sprintf("File is %.1f MB; the limit is 100 MB.", input$file$size / 1024^2)
  ))

  # 2. Extension
  ext <- tolower(tools::file_ext(input$file$name))
  validate(need(
    ext %in% c("csv", "sas7bdat", "xpt", "xlsx"),
    paste0("Cannot read .", ext, " files. Upload CSV, SAS7BDAT, XPT or XLSX.")
  ))

  # 3. Read, with a readable error if it fails
  d <- tryCatch(
    read_by_ext(input$file$datapath, ext),
    error = function(e) {
      validate(paste("Could not read the file:", conditionMessage(e)))
    }
  )

  # 4. Content contract
  validate(
    need(nrow(d) > 0, "The file contains no rows."),
    need("USUBJID" %in% names(d),
         paste0("Required column USUBJID not found. Columns present: ",
                paste(head(names(d), 8), collapse = ", "), "."))
  )

  # 5. Warn about things that are odd but not fatal
  if (anyDuplicated(d$USUBJID) > 0) {
    showNotification(
      sprintf("%d duplicate USUBJID values found.", sum(duplicated(d$USUBJID))),
      type = "warning", duration = 10
    )
  }

  d
})
ImportantNever source() or readRDS() an untrusted file 
readRDS(input$file$datapath)   # can execute arbitrary code on deserialisation
source(input$file$datapath)    # obviously executes arbitrary code
load(input$file$datapath)      # same problem as readRDS

If the app is exposed to anyone you would not give shell access to, restrict uploads to inert formats: CSV, Excel, SAS7BDAT, XPT, Parquet. An RDS file can carry a payload that runs the moment it is deserialised.

Also sanitise the filename before using it in a path:

safe_name <- fs::path_sanitize(input$file$name)

Otherwise ../../etc/something is a directory-traversal vulnerability.

Multiple files

ui <- fileInput("files", "Upload domain datasets", multiple = TRUE,
                accept = c(".sas7bdat", ".xpt"))

domains <- reactive({
  req(input$files)

  purrr::map(seq_len(nrow(input$files)), function(i) {
    name <- input$files$name[i]
    path <- input$files$datapath[i]
    list(
      domain = toupper(tools::file_path_sans_ext(name)),
      data   = haven::read_sas(path)
    )
  }) |>
    purrr::set_names(purrr::map_chr(_, "domain")) |>
    purrr::map("data")
})

output$loaded <- renderText({
  sprintf("Loaded %d domains: %s",
          length(domains()), paste(names(domains()), collapse = ", "))
})

Progress for a large batch:

domains <- reactive({
  req(input$files)
  n <- nrow(input$files)

  withProgress(message = "Reading files", value = 0, {
    purrr::map(seq_len(n), function(i) {
      incProgress(1/n, detail = input$files$name[i])
      haven::read_sas(input$files$datapath[i])
    })
  })
})

Downloading

downloadButton() or downloadLink() in the UI, downloadHandler() in the server.

ui <- downloadButton("download", "Download data", class = "btn-primary")

server <- function(input, output, session) {
  output$download <- downloadHandler(
    filename = function() {
      sprintf("adsl_%s.csv", format(Sys.Date(), "%Y%m%d"))
    },
    content = function(file) {
      readr::write_csv(filtered(), file)
    },
    contentType = "text/csv"
  )
}

Both filename and content are functions. filename is evaluated when the user clicks, so it can be dynamic. content receives a temporary path and must write to it.

WarningdownloadHandler cannot use req()

req() inside a download handler produces a broken download rather than a clean stop, because the browser has already started the request. Guard the button instead:

observe({
  shinyjs::toggleState("download", condition = nrow(filtered()) > 0)
})

And handle failure inside content by writing an informative file:

content = function(file) {
  if (nrow(filtered()) == 0) {
    writeLines("No data matched the current filters.", file)
    return()
  }
  readr::write_csv(filtered(), file)
}

Excel

output$download_xlsx <- downloadHandler(
  filename = function() sprintf("study_export_%s.xlsx", Sys.Date()),
  content = function(file) {
    wb <- openxlsx::createWorkbook()

    openxlsx::addWorksheet(wb, "Subjects")
    openxlsx::writeData(wb, "Subjects", adsl_filtered(), headerStyle =
      openxlsx::createStyle(textDecoration = "bold", fgFill = "#16355e",
                            fontColour = "white"))
    openxlsx::freezePane(wb, "Subjects", firstRow = TRUE)
    openxlsx::setColWidths(wb, "Subjects", cols = 1:ncol(adsl_filtered()),
                           widths = "auto")

    openxlsx::addWorksheet(wb, "Adverse events")
    openxlsx::writeData(wb, "Adverse events", adae_filtered())

    openxlsx::addWorksheet(wb, "Metadata")
    openxlsx::writeData(wb, "Metadata", tibble::tibble(
      Item  = c("Generated", "User", "Filters", "R version", "App version"),
      Value = c(format(Sys.time()), session$user %||% "unknown",
                describe_filters(), R.version.string, APP_VERSION)
    ))

    openxlsx::saveWorkbook(wb, file, overwrite = TRUE)
  }
)

The metadata sheet is not decoration. When someone emails you a spreadsheet six months later asking why the numbers differ, that sheet is the answer.

Zip archives

output$download_all <- downloadHandler(
  filename = function() sprintf("study_export_%s.zip", Sys.Date()),
  content = function(file) {
    tmp <- tempfile()
    dir.create(tmp)
    on.exit(unlink(tmp, recursive = TRUE), add = TRUE)

    readr::write_csv(adsl_filtered(), file.path(tmp, "adsl.csv"))
    readr::write_csv(adae_filtered(), file.path(tmp, "adae.csv"))
    ggplot2::ggsave(file.path(tmp, "summary.png"), current_plot(),
                    width = 10, height = 6, dpi = 300)
    writeLines(capture.output(sessionInfo()), file.path(tmp, "sessionInfo.txt"))

    zip::zip(file, files = list.files(tmp), root = tmp)
  }
)

zip::zip() is preferable to utils::zip() — it does not shell out to an external zip binary, so it works identically on Windows.

Plots

output$download_plot <- downloadHandler(
  filename = function() sprintf("figure_%s.%s", Sys.Date(), input$format),
  content = function(file) {
    ggplot2::ggsave(
      file, plot = current_plot(),
      device = input$format,
      width  = input$width, height = input$height,
      units  = "in", dpi = 300
    )
  }
)

Give the user control of dimensions — a figure destined for a slide and one for a manuscript need different aspect ratios, and re-cropping a PNG is miserable.

RTF for clinical outputs

output$download_rtf <- downloadHandler(
  filename = function() "t-14-1-1-demographics.rtf",
  content = function(file) {
    summary_table() |>
      r2rtf::rtf_title("Table 14.1.1",
                       "Demographic and Baseline Characteristics",
                       "Safety Analysis Set") |>
      r2rtf::rtf_colheader("Characteristic | Placebo | Drug A | Total",
                           col_rel_width = c(4, 2, 2, 2)) |>
      r2rtf::rtf_body(col_rel_width = c(4, 2, 2, 2),
                      text_justification = c("l", "c", "c", "c")) |>
      r2rtf::rtf_footnote("Percentages are based on the number of subjects
                           in the safety analysis set.") |>
      r2rtf::rtf_source(sprintf("Program: app.R  Generated: %s",
                                format(Sys.time(), "%d%b%Y %H:%M"))) |>
      r2rtf::rtf_encode() |>
      r2rtf::write_rtf(file)
  }
)

See TLF generation and r2rtf, Tplyr and related packages for the full treatment.

Generating reports

Render a parameterised Quarto or R Markdown document from the app:

output$report <- downloadHandler(
  filename = function() {
    sprintf("study_report_%s.%s", Sys.Date(),
            switch(input$format, html = "html", pdf = "pdf", docx = "docx"))
  },
  content = function(file) {
    # Copy the template somewhere writable — the app directory may be read-only
    tmp_report <- file.path(tempdir(), "report.qmd")
    file.copy("report_template.qmd", tmp_report, overwrite = TRUE)

    params <- list(
      data        = filtered(),
      arm         = input$arm,
      generated_by = session$user %||% "unknown",
      generated_at = Sys.time()
    )

    withProgress(message = "Rendering report", value = 0.3, {
      quarto::quarto_render(
        input       = tmp_report,
        output_file = basename(file),
        execute_params = params,
        # Render in a separate process so the app's environment cannot leak in
        as_job = FALSE
      )
      incProgress(0.6)
      file.copy(file.path(tempdir(), basename(file)), file, overwrite = TRUE)
    })
  }
)

The template:

---
title: "Study ABC-101 — Filtered Data Summary"
params:
  data: null
  arm: "All"
  generated_by: "unknown"
  generated_at: null
format: html
---

Generated by `r params$generated_by` on
`r format(params$generated_at, "%d %B %Y at %H:%M")`.
Treatment arm filter: **`r params$arm`**.

```{r}
#| echo: false
knitr::kable(summary_table(params$data))
```

Rendering in a separate process is the important detail: rmarkdown and quarto evaluate in an environment you do not fully control, and rendering in-process can pick up objects from the app or leave the app’s state modified.

Common mistakes

Mistake Consequence Fix
Trusting datapath’s extension Wrong reader chosen Use input$file$name
No size limit Server memory exhausted options(shiny.maxRequestSize)
readRDS() on an upload Arbitrary code execution Inert formats only
Unsanitised filename in a path Directory traversal fs::path_sanitize()
req() in downloadHandler Broken download Disable the button instead
Non-function filename Static name, wrong date function() ...
No metadata in exports Unreproducible numbers Add a metadata sheet
Rendering reports in-process State leakage, odd failures Separate process

Exercise 7.1 — Validated upload

Build an upload handler that accepts CSV, SAS7BDAT or XPT, validates that the file contains USUBJID, AVAL and PARAMCD, that AVAL is numeric, and that USUBJID has no missing values. Report every problem at once rather than the first one.

Show solution 
library(shiny); library(dplyr)

read_any <- function(path, name) {
  ext <- tolower(tools::file_ext(name))
  switch(ext,
    csv      = readr::read_csv(path, show_col_types = FALSE),
    sas7bdat = haven::read_sas(path),
    xpt      = haven::read_xpt(path),
    stop("Unsupported file type: .", ext)
  )
}

check_bds <- function(d) {
  problems <- character()

  required <- c("USUBJID", "PARAMCD", "AVAL")
  missing  <- setdiff(required, names(d))
  if (length(missing) > 0) {
    problems <- c(problems,
      sprintf("Missing required column(s): %s", paste(missing, collapse = ", ")))
  }

  if ("AVAL" %in% names(d) && !is.numeric(d$AVAL)) {
    n_bad <- sum(is.na(suppressWarnings(as.numeric(as.character(d$AVAL)))) &
                 !is.na(d$AVAL))
    problems <- c(problems, sprintf(
      "AVAL is %s, not numeric (%d value(s) cannot be converted).",
      class(d$AVAL)[1], n_bad))
  }

  if ("USUBJID" %in% names(d)) {
    n_missing <- sum(is.na(d$USUBJID) | trimws(as.character(d$USUBJID)) == "")
    if (n_missing > 0) {
      problems <- c(problems,
        sprintf("USUBJID is missing in %d row(s).", n_missing))
    }
  }

  if (nrow(d) == 0) problems <- c(problems, "The file contains no rows.")

  problems
}

server <- function(input, output, session) {

  uploaded <- reactive({
    req(input$file)

    validate(need(
      input$file$size < 100 * 1024^2,
      sprintf("File is %.1f MB; the limit is 100 MB.", input$file$size / 1024^2)
    ))

    d <- tryCatch(
      read_any(input$file$datapath, input$file$name),
      error = function(e) validate(paste("Could not read the file:",
                                         conditionMessage(e)))
    )

    problems <- check_bds(d)

    # Report ALL problems in one message
    validate(need(
      length(problems) == 0,
      paste0("The uploaded file has ", length(problems), " problem(s):\n",
             paste0("  • ", problems, collapse = "\n"))
    ))

    showNotification(
      sprintf("Loaded %s: %s rows, %d parameters.",
              input$file$name, format(nrow(d), big.mark = ","),
              dplyr::n_distinct(d$PARAMCD)),
      type = "message"
    )
    d
  })

  output$preview <- DT::renderDT(DT::datatable(head(uploaded(), 100)))
}
Collecting problems into a vector rather than stopping at the first is the design point. A user whose file has three issues should be told all three, not made to re-upload three times. The same principle applies to the import functions in R Programming lesson 4.

Exercise 7.2 — Multi-format export

Add an export panel offering CSV, Excel (with a metadata sheet), and a zip containing both plus the current figure. Disable the buttons when there is nothing to export.

Show solution 
library(shiny); library(bslib); library(shinyjs)

ui <- page_sidebar(
  useShinyjs(),
  sidebar = sidebar(
    # ... filters ...
    hr(),
    h6("Export"),
    downloadButton("dl_csv",  "CSV",   class = "btn-sm w-100 mb-1"),
    downloadButton("dl_xlsx", "Excel", class = "btn-sm w-100 mb-1"),
    downloadButton("dl_zip",  "Zip (all)", class = "btn-sm w-100")
  ),
  card(plotOutput("plot")),
  card(DT::DTOutput("table"))
)

server <- function(input, output, session) {

  filtered <- reactive({ ... })

  current_plot <- reactive({
    ggplot2::ggplot(filtered(), ggplot2::aes(AGE, fill = TRT01P)) +
      ggplot2::geom_histogram(binwidth = 5, colour = "white") +
      ggplot2::theme_minimal(base_size = 13)
  })

  output$plot <- renderPlot(current_plot(), res = 96)

  # Disable exports when there is nothing to export
  observe({
    ok <- nrow(filtered()) > 0
    toggleState("dl_csv",  condition = ok)
    toggleState("dl_xlsx", condition = ok)
    toggleState("dl_zip",  condition = ok)
  })

  # Shared metadata
  export_metadata <- reactive({
    tibble::tibble(
      Item = c("Generated", "User", "Treatment arm", "Age range",
               "Safety population only", "Rows exported",
               "R version", "App version"),
      Value = c(
        format(Sys.time(), "%Y-%m-%d %H:%M:%S %Z"),
        session$user %||% "unknown",
        input$arm,
        paste(input$age, collapse = " to "),
        as.character(isTRUE(input$saffl)),
        as.character(nrow(filtered())),
        R.version.string,
        as.character(utils::packageVersion("shiny"))
      )
    )
  })

  stamp <- function() format(Sys.time(), "%Y%m%d_%H%M")

  # --- CSV ---------------------------------------------------------------
  output$dl_csv <- downloadHandler(
    filename = function() sprintf("adsl_filtered_%s.csv", stamp()),
    content  = function(file) {
      if (nrow(filtered()) == 0) {
        writeLines("No data matched the current filters.", file)
        return()
      }
      readr::write_csv(filtered(), file, na = "")
    }
  )

  # --- Excel -------------------------------------------------------------
  output$dl_xlsx <- downloadHandler(
    filename = function() sprintf("adsl_filtered_%s.xlsx", stamp()),
    content  = function(file) {
      hdr <- openxlsx::createStyle(textDecoration = "bold",
                                   fgFill = "#16355e", fontColour = "white")
      wb <- openxlsx::createWorkbook()

      openxlsx::addWorksheet(wb, "Data")
      openxlsx::writeData(wb, "Data", filtered(), headerStyle = hdr)
      openxlsx::freezePane(wb, "Data", firstRow = TRUE)
      openxlsx::setColWidths(wb, "Data", 1:ncol(filtered()), widths = "auto")

      openxlsx::addWorksheet(wb, "Metadata")
      openxlsx::writeData(wb, "Metadata", export_metadata(), headerStyle = hdr)
      openxlsx::setColWidths(wb, "Metadata", 1:2, widths = c(24, 46))

      openxlsx::saveWorkbook(wb, file, overwrite = TRUE)
    }
  )

  # --- Zip ---------------------------------------------------------------
  output$dl_zip <- downloadHandler(
    filename = function() sprintf("adsl_export_%s.zip", stamp()),
    content  = function(file) {
      tmp <- file.path(tempdir(), paste0("export_", stamp()))
      dir.create(tmp, showWarnings = FALSE)
      on.exit(unlink(tmp, recursive = TRUE), add = TRUE)

      withProgress(message = "Building archive", value = 0, {
        incProgress(0.2, detail = "Writing data")
        readr::write_csv(filtered(), file.path(tmp, "data.csv"), na = "")
        readr::write_csv(export_metadata(), file.path(tmp, "metadata.csv"))

        incProgress(0.4, detail = "Rendering figure")
        ggplot2::ggsave(file.path(tmp, "figure.png"), current_plot(),
                        width = 10, height = 6, dpi = 300)

        incProgress(0.3, detail = "Recording session")
        writeLines(capture.output(sessionInfo()),
                   file.path(tmp, "sessionInfo.txt"))

        incProgress(0.1, detail = "Compressing")
        zip::zip(file, files = list.files(tmp), root = tmp)
      })
    }
  )
}
The three handlers share export_metadata() and stamp(), so the timestamp and the recorded filters are guaranteed consistent across formats. Including sessionInfo() in the archive costs one line and answers the “which package versions produced this?” question that always eventually arrives.

Recap

  • input$file is a data frame; use $name for the extension, $datapath to read
  • Raise shiny.maxRequestSize; validate size, type and contents before use
  • Never readRDS(), load() or source() an untrusted upload
  • filename and content are both functions; req() does not work in a handler
  • Disable download buttons rather than guarding inside the handler
  • Always include metadata — filters, user, timestamp, versions — in exports
  • Render reports in a separate process

Next: Authentication.

Back to top