Upload Shiny Logfiles to WebDAV Server - r

Question

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.

Answer 1

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)
})
)