Showing how to get the Shiny to properly handle image uploads

fancy-editor.R

library(shiny)

# The browser will send files inserted into the editor here
upload_path <- "/upload-image"

# Only accept PNGs for now
supported_file_types <- c("png")

shiny_editor_options <- paste(
  "plugins: 'image'",
  sprintf("images_upload_url: '%s'", upload_path),
  sprintf("image_file_types: '%s'", paste(supported_file_types, collapse = ",")),
  "images_file_types: 'png'",
  sep = ",\n"
)

# UI
ui <- fluidPage(
  # Setup
  ShinyEditor::use_editor("TODO-API-Key"),
  titlePanel("HTML Generator"),

  # Editor UI
  fluidRow(
    column(
      width = 6,
      ShinyEditor::editor("textcontent", options = shiny_editor_options),
      br(),
      actionButton(
        "generatehtml",
        "Generate HTML Code",
        icon = icon("code"),
        class = "btn-primary"
      )
    ),
    column(
      width = 6,
      tags$pre(textOutput("rawText"))
    )
  )
)

images_directory <- "images"

if (!dir.exists(images_directory)) {
  dir.create(images_directory)
}

file_upload_handler <- function(request) {
  upload <- mime::parse_multipart(request)
  # We're only accepting PNG files for now, so can just hard-code the extension.
  # but the `upload` argument contains the file type ("MIME" type) which could be
  # mapped to an extension in future.
  extension <- "png"
  location <- sprintf("%s/%s.%s", images_directory, uuid::UUIDgenerate(), extension)
  file.copy(upload$file$datapath, location)
  httpResponse(
    status = 200L,
    content_type = "application/json",
    # https://www.tiny.cloud/docs/general-configuration-guide/upload-images/#imageuploaderrequirements
    content = sprintf('{"location": "%s"}', location)
  )
}

file_download_handler <- function(path) {
  file_conn <- file(path, "rb")
  binary_data <- readBin(file_conn, what = "raw", n = file.info(path)$size)
  close(file_conn)
  print(binary_data)
  httpResponse(
    status = 200L,
    content_type = "image/png",
    content = binary_data
  )
}

# Credit to:
# https://gist.github.com/jcheng5/2aaff19e67079840350d08361fe7fb20
router <- function(request) {
  method <- request$REQUEST_METHOD
  path <- request$PATH_INFO

  if (identical(method, "POST")) {
    # Handle POST requests
    if (identical(path, upload_path)) {
      # Handle image uploads
      file_upload_handler(request)
    } else {
      # wtf
      httpResponse(
        status = 404L,
        content_type = "text/plain",
        content = "not found"
      )
    }
  } else if (identical(method, "GET")) {
    path_without_leading_slash <- substring(path, 2)
    # Handle GET requests
    if (startsWith(path_without_leading_slash, images_directory)) {
      # Serve up image files when the request is /images/*
      file_download_handler(path_without_leading_slash)
    } else {
      # Serve the shiny UI for all other GET requests!
      ui
    }
  } else {
    # wtf
    httpResponse(
      status = 404L,
      content_type = "text/plain",
      content = "not found"
    )
  }
}

attr(router, "http_methods_supported") <- c("GET", "POST")

# Server
server <- function(input, output, session) {
  # Generate HTML
  observeEvent(input$generatehtml, {
    ShinyEditor::editorText(
      session,
      editorid = "textcontent", outputid = "mytext"
    )

    output$rawText <- renderText({
      req(input$mytext)
      enc2utf8(input$mytext)
    })
  })
}

# Run App
shinyApp(
  ui = router,
  server = server,
  # Accept HTTP requests to any path,
  # and handle them in the router.
  uiPattern = ".*",

  # Use a static port to make developing/reloading easier
  options = list(port = 8080),
)