Search code examples
rshinyhttr

Upload Shiny Logfiles to WebDAV Server


We are running several shiny apps for educational purposes on shinyapps.io. In order to track the usage we tried the shinylogs package locally, which worked out fine. Now the goal is to upload the logfiles created by shinylogs on shinyapps.io to a WebDAV server.

The file upload itself can be achieved with the following code. Note, that I have not revealed my true credentials for security reasons. So this request won't actually work for you.

username <- "xxx"
password <- "yyy"

file <- upload_file("test.txt")
PUT("https://fernuni-hagen.sciebo.de/public.php/webdav/test.txt", authenticate(username, password), body = file)

As the next step I created a function out of it, which also works fine.

upload <- function(filename){
  body <- upload_file(filename)
  PUT(paste0("https://fernuni-hagen.sciebo.de/public.php/webdav/", filename), authenticate(username, password), body = body)
}

upload("test.txt")

Finally, I tried to combine this code with the track_usage command of shinylogs. According to the documentation the store_custom mode should be suitable. Not finding any working example on the web, I was unable to figure out the right syntax, though.

Instead of a single file specified upfront, the function should upload any new logfile to the WebDAV server. In order to clarify my requirements, I have created this simple demo app.

library(shiny)
library(shinylogs)
library(httr)

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Old Faithful Geyser Data"),
    
    fluidRow(
    # Sidebar with a slider input for number of bins  
    sidebarLayout(
        sidebarPanel(
            sliderInput("bins1",
                        "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30)),
        mainPanel(
          # Show a plot of the generated distribution
          plotOutput("distPlot1")
        ))),
    
    fluidRow(
      # Sidebar with a slider input for number of bins (and action button)
    sidebarLayout(
        sidebarPanel(
            sliderInput("bins2",
                        "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30),
            actionButton("go", "Update Plot")),
        mainPanel(
          # Show a plot of the generated distribution
          plotOutput("distPlot2")
        )))
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  
  username <- "xxx"
  password <- "yyy"
  
  track_usage(storage_mode = store_custom(FUN = function(logs){
    body <- upload_file(logs)
    url <- paste0("https://fernuni-hagen.sciebo.de/public.php/webdav/", logs)
    PUT(url, authenticate(username, password), body = body)
  }))
    
    output$distPlot1 <- renderPlot({
        # generate bins based on input$bins from ui.R
        x    <- faithful[, 2]
        bins <- seq(min(x), max(x), length.out = input$bins1 + 1)

        # draw the histogram with the specified number of bins
        hist(x, breaks = bins, col = 'darkgray', border = 'white')
    })
    
    output$distPlot2 <- renderPlot({
        # generate bins based on input$bins from ui.R (only upon click)     
        input$go
        x    <- faithful[, 2]
        bins <- seq(min(x), max(x), length.out = isolate(input$bins2) + 1)
        
        # draw the histogram with the specified number of bins
        hist(x, breaks = bins, col = 'darkgray', border = 'white')
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

When I run this shiny app locally, there is no error message in the R console, but the files will never arrive on the WebDAV server. Any help to fix this issue would be much appreciated.


Solution

  • So this is my own solution.

    # Configuration of logging directory
    logsdir <- "~/logs"
    
    # Create directory for log files, if not existent
    if(!dir.exists(logsdir)) dir.create(logsdir)
    
    # Usage tracking with JSON file being saved on Shiny and WebDAV Servers
    track_usage(
      storage_mode = store_custom(FUN = function(logs) {
      jsondata <- toJSON(logs)
      filename <- paste0("shinylogs_", session$token, ".json")
      filepath <- paste0(logsdir, "/", filename)
      write(jsondata, file = filepath)
      body <- upload_file(filepath)
      url <- paste0("https://fernuni-hagen.sciebo.de/public.php/webdav/", filename)
      PUT(url, authenticate(username, password), body = body)
    })
    )