Shiny app which downloads zip file does not work on Shiny Live

shiny
1

Hi. I am creating a shiny app in R. You need to paste xml code in a box, and it downloads a zip file containing the xml file, and an additional xml file. It's to help people generate quizzes for Virtual Leaning Environment. I would love to get it to work with ShinyLive.

It works offline, but when I try to run it in ShinyLive (Shiny editor) the download fails. It just downloads a single .xml file, and the naming does not work (the file it downloads is "downloadButton.xml").

I am presuming that this is a limitation of ShinLive versus ShinyServer, possibly related to security considerations, but it would be great to know if there is a fix to this. (NB all packages are available in ShinyLive according to https://repo.r-wasm.org)

Code is below

Thanks


library(shiny)
library(ids)
library(xml2)
library(zip)

ui <- fluidPage(
  navbarPage("QTI creator"),
  textAreaInput(inputId = "XML_input",
                label = "Enter XML quiz:",
                placeholder = "XML data",
                width = "100%", height = "200px", resize = "both"),
  textOutput("textoutput"), # Just to check things work
  downloadButton(outputId = "downloadButton", label = "Download zip file", class = NULL)
)

server <- function(input, output) {
  
  quiz_text = reactive(input$XML_input)
  
  output$downloadButton <- downloadHandler(
    filename = function() {
      paste("data-", Sys.Date(), ".zip", sep="")
    },
    
    content = function(file) {
      
      # browser()
      
      xml_input <- quiz_text()
      if (is.null(xml_input) || xml_input == "") {
        writeLines("No XML provided.", file)
        return()
      }
      
      # Try to parse the XML input
      quiz_xml <- tryCatch({
        read_xml(xml_input)
      }, error = function(e) NULL)
      
      if (is.null(quiz_xml)) {
        writeLines("Invalid XML provided.", file)
        return()
      }
      
      # Create a clean temp directory
      temp_dir <- tempfile()
      dir.create(temp_dir)
      
      # Write the XML to a file with a fixed name
      xml_path <- file.path(temp_dir, "quiz.xml")
      write_xml(quiz_xml, xml_path)
      
      imsmanifest = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
        <manifest identifier=\"man001\" xmlns=\"http://www.imsglobal.org/xsd/imscp_v1p1\"
      xmlns:imsmd=\"http://www.imsglobal.org/xsd/imsmd_v1p2\"
      xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"
      xsi:schemaLocation=\"http://www.imsglobal.org/xsd/imscp_v1p1 
          http://www.imsglobal.org/xsd/imsmd_v1p2 
          http://www.imsglobal.org/xsd/imscp_v1p1.xsd 
          http://www.imsglobal.org/xsd/imsmd_v1p2.xsd\">
        <resources>
        <resource identifier=\"res_q1\" type=\"imsqti_item_xmlv1p2\" href=\"quiz.xml\">
        <file href=\"quiz.xml\"/>
        </resource>
        </resources>
        </manifest>"
      
      imsmanifest_xml <- tryCatch({
        read_xml(imsmanifest)
      }, error = function(e) NULL)
      
      manifest_path <- file.path(temp_dir, "imsmanifest.xml")
      write_xml(imsmanifest_xml, manifest_path)
      
      # Zip ONLY that file from its directory (no folder structure)
      zip::zipr(zipfile = file, files = c("quiz.xml", "imsmanifest.xml"), root = temp_dir)
    }
    
  )
  
  output$textoutput <- renderText({
    paste("Entered code:,", quiz_text())
  })
  
}

shinyApp(ui = ui, server = server)
2

Bingo! I recall having a similar issue before, and someone on this forum identified an issue with download widgets on chrome. Here is the workaround. If you put this at the beginning of the app the download works

# Workaround for Chromium Issue 468227 from https://forum.posit.co/t/shinylive-download-works-with-firefox-fails-on-chrome/198542
downloadButton <- function(...) {
  tag <- shiny::downloadButton(...)
  tag$attribs$download <- NULL
  tag
}