Search code examples
rshinydropboxshinyappsrdrop2

R Shiny server dropbox connection works for sometime and then says "cannot connect to server" - error in drop_upload: Unauthorized (HTTP401)

I have used this code for a long time but I recently changed the dropbox account I wanted the .csv files to be sent to and now the app works, meaning you can open it fill in the inputs, but upon submitting the authentication works for a period of time but then timeouts and the shiny server sends back "cannot connect to server" error in response to the failed dropbox connection. The app is served on shinyapps.io.

For example if I renew the drop_auth() and save the token in the morning around 9:00 am the application works and the data is saved from any user info and uploaded to dropbox correctly. If you tried the app around 5:00 pm you would get the "cannot connect to server" error.

I have repeatedly followed the code in rdrop2 on GitHub for server storage of the token and it is exactly what I had, I recently commented out two lines:

token <- drop_auth() # only to be runlocally
saveRDS(token, "droptoken.rds") # only to be runlocally

based on some suggestions I found on stackoverflow, to no avail.

Here is the error output when I try to submit from RStudio after the auth has timed out. screenshot of console

Here are the logs from shinnyapps.io that shows successful uploads in March and then the HTTP401 error I am receiving now.

March

2022-04-06T19:33:16.468976+00:00 shinyapps[2609864]: Running on host: 32f301fb17ba
2022-04-06T19:33:16.469040+00:00 shinyapps[2609864]: Server version: 2022.03.1
2022-04-06T19:33:16.469113+00:00 shinyapps[2609864]: LANG: C.UTF-8
2022-04-06T19:33:16.469156+00:00 shinyapps[2609864]: Working directory: /srv/connect/apps/ordering_sheet
2022-04-06T19:33:16.469201+00:00 shinyapps[2609864]: R version: 4.0.4
2022-04-06T19:33:16.469243+00:00 shinyapps[2609864]: shiny version: 1.7.1
2022-04-06T19:33:16.469287+00:00 shinyapps[2609864]: httpuv version: 1.6.3
2022-04-06T19:33:16.469375+00:00 shinyapps[2609864]: knitr version: 1.36
2022-04-06T19:33:16.469330+00:00 shinyapps[2609864]: rmarkdown version: (none)
2022-04-06T19:33:16.469418+00:00 shinyapps[2609864]: jsonlite version: 1.7.2
2022-04-06T19:33:16.469462+00:00 shinyapps[2609864]: RJSONIO version: (none)
2022-04-06T19:33:16.469514+00:00 shinyapps[2609864]: htmltools version: 0.5.2
2022-04-06T19:33:16.469556+00:00 shinyapps[2609864]: reticulate version: (none)
2022-04-06T19:33:16.469604+00:00 shinyapps[2609864]: Using pandoc: /opt/connect/ext/pandoc/2.16
2022-04-06T19:33:16.469657+00:00 shinyapps[2609864]: Using jsonlite for JSON processing
2022-04-06T19:33:16.469716+00:00 shinyapps[2609864]: 
2022-04-06T19:33:16.469784+00:00 shinyapps[2609864]: Starting R with process ID: '26'
2022-04-06T19:33:16.469837+00:00 shinyapps[2609864]: Shiny application starting ...
2022-04-06T19:33:16.469898+00:00 shinyapps[2609864]: 
2022-04-06T19:33:16.469947+00:00 shinyapps[2609864]: Attaching package: ‘rsconnect’
2022-04-06T19:33:16.469996+00:00 shinyapps[2609864]: 
2022-04-06T19:33:16.470036+00:00 shinyapps[2609864]: The following object is masked from ‘package:shiny’:
2022-04-06T19:33:16.470073+00:00 shinyapps[2609864]: 
2022-04-06T19:33:16.470115+00:00 shinyapps[2609864]:     serverInfo
2022-04-06T19:33:16.470158+00:00 shinyapps[2609864]: 
2022-04-06T19:33:16.470193+00:00 shinyapps[2609864]: 
2022-04-06T19:33:16.470227+00:00 shinyapps[2609864]: Listening on http://127.0.0.1:38251
2022-04-06T19:34:42.491153+00:00 shinyapps[2609864]: File /tmp/Rtmpwebpaa/order_by_Pablo Maldonado_for_PE anti-mouse CD45 Antibody 200 ug_submitted_2022-04-06 19:34:40.csv uploaded as /ordering/order_by_Pablo Maldonado_for_PE anti-mouse CD45 Antibody 200 ug_submitted_2022-04-06 19:34:40.csv successfully at 2022-04-06T19:34:41Z

April

2022-04-21T14:10:12.297606+00:00 shinyapps[2609864]: Listening on http://127.0.0.1:45947
2022-04-21T14:16:55.352973+00:00 shinyapps[2609864]: Running on host: e65fb8259896
2022-04-21T14:16:55.353065+00:00 shinyapps[2609864]: Server version: 2022.03.1
2022-04-21T14:16:55.353135+00:00 shinyapps[2609864]: LANG: C.UTF-8
2022-04-21T14:16:55.353313+00:00 shinyapps[2609864]: shiny version: 1.7.1
2022-04-21T14:16:55.353190+00:00 shinyapps[2609864]: Working directory: /srv/connect/apps/ordering_sheet
2022-04-21T14:16:55.353436+00:00 shinyapps[2609864]: rmarkdown version: (none)
2022-04-21T14:16:55.353373+00:00 shinyapps[2609864]: httpuv version: 1.6.3
2022-04-21T14:16:55.353556+00:00 shinyapps[2609864]: jsonlite version: 1.7.2
2022-04-21T14:16:55.353251+00:00 shinyapps[2609864]: R version: 4.0.4
2022-04-21T14:16:55.353498+00:00 shinyapps[2609864]: knitr version: 1.36
2022-04-21T14:16:55.353612+00:00 shinyapps[2609864]: RJSONIO version: (none)
2022-04-21T14:16:55.353669+00:00 shinyapps[2609864]: htmltools version: 0.5.2
2022-04-21T14:16:55.353724+00:00 shinyapps[2609864]: reticulate version: (none)
2022-04-21T14:16:55.353781+00:00 shinyapps[2609864]: Using pandoc: /opt/connect/ext/pandoc/2.16
2022-04-21T14:16:55.353898+00:00 shinyapps[2609864]: 
2022-04-21T14:16:55.353837+00:00 shinyapps[2609864]: Using jsonlite for JSON processing
2022-04-21T14:16:55.353995+00:00 shinyapps[2609864]: Starting R with process ID: '247'
2022-04-21T14:16:55.354119+00:00 shinyapps[2609864]: 
2022-04-21T14:16:55.354057+00:00 shinyapps[2609864]: Shiny application starting ...
2022-04-21T14:16:55.354276+00:00 shinyapps[2609864]: 
2022-04-21T14:16:55.354203+00:00 shinyapps[2609864]: Attaching package: ‘rsconnect’
2022-04-21T14:16:55.354512+00:00 shinyapps[2609864]:     serverInfo
2022-04-21T14:16:55.354456+00:00 shinyapps[2609864]: 
2022-04-21T14:16:55.354388+00:00 shinyapps[2609864]: The following object is masked from ‘package:shiny’:
2022-04-21T14:16:55.354623+00:00 shinyapps[2609864]: 
2022-04-21T14:16:55.354568+00:00 shinyapps[2609864]: 
2022-04-21T14:16:55.354680+00:00 shinyapps[2609864]: Listening on http://127.0.0.1:39583
2022-04-21T14:17:00.296007+00:00 shinyapps[2609864]:   [No stack trace available]
2022-04-21T14:17:00.295907+00:00 shinyapps[2609864]: Warning: Error in drop_upload: Unauthorized (HTTP 401).

Below is the current app and code.

https://burtonkarger.shinyapps.io/ordering_sheet/

library(shiny)
library(rsconnect)
library(rdrop2)

input_fields <- c("name", "vendor", "item", "cat", "fund","quantity", "price", 
                  "rec_date", "note")

#unused_input_fields <- c("email", "date")

outputDir <- "https://www.dropbox.com/home/Ordering"


# user interface to interact with form
shinyApp(
    ui = fluidPage(theme = "bootstrap.css", 
                   shinyjs::useShinyjs(),
    div(id = "overall_form",
    h1(strong("Ordering Form")),
    #shinyjs::hidden(div(id = "reset_msg", h3(strong(em("Form Reset")), style="color:red"))),
    div(id = "form gen info",
        div(textInput("name", "Name", placeholder = "First Name"),
            #textInput("email", "Email Address", 
                      #placeholder = "[email protected]"),
            #dateInput("date", "Date", value = Sys.Date())
        )
        ),
    div(id = "form"),
    h4((strong("Item Information"))),
    div(id = "form_order_info",
            textInput("vendor", "Vendor", placeholder = "ex. VWR"),
            textInput("item", "Item", placeholder = "ex. 1000 ul tips"),
            textInput("cat", "Catalog #", placeholder = "83007-382"),
            numericInput("price", "Price $", value = ""),
            textInput("fund", "Fund Number", placeholder = "RO1 or RAPTORs"),
            numericInput("quantity", "Quantity", value = 1),
            textInput("rec_date", "Desired Receiving Date", 
                      placeholder = "1 week"),
            textInput("note", "Notes", placeholder = "ex. need one case")
        ),
    shinyjs::hidden(
        div(
            id = "thankyou_msg",
            h3(strong("Item submitted, would you like to input another? 
                      Otherwise, click exit."), style="color:red")
        )
    ),
    div(id = "buttons",
        actionButton("submit", "Submit Item", class = "btn-primary"),
        actionButton("order_complete", "Exit", 
                     class = "btn-primary"),
        #actionButton("reset", "Reset Form", class = "btn-primary")
    ),
    div(h2(strong("SPACE")), style = "color: white;")
    ),
    shinyjs::hidden(
        div(
            id = "quit_msg",
            h3(strong("Thanks for the order!"), style = "text-align: center")
        )
        )
),

    server = function(input, output, session) {
    
        # Drop box connection
        #token <- drop_auth() # only to be runlocally
        #saveRDS(token, "droptoken.rds") # only to be runlocally
        token <- readRDS("droptoken.rds")
        drop_acc(dtoken = token)
    
        formData <- reactive({
            data <- sapply(input_fields, function(x) input[[x]])
            data <- t(data)
            data
        })
        
        outputDir <- "ordering"
        
        saveData <- function(data) {
            data <- t(data)
            # Create a unique file name
            fileName <- paste0("order_by_", data[1], "_for_", 
                               data[3], "_", "submitted_", 
                               Sys.time(), ".csv")
            # Write the data to a temporary file locally
            filePath <- file.path(tempdir(), fileName)
            write.csv(data, filePath, row.names = TRUE, quote = TRUE)
            # Upload the file to Dropbox
            drop_upload(filePath, path = outputDir)
        }
        
        observeEvent(input$submit, {
            saveData(formData())
            #shinyjs::hide("form gen info")
            #shinyjs::hide("reset_msg")
            shinyjs::reset("overall_form")
            shinyjs::reset("form_order_info")
            shinyjs::show("thankyou_msg")
        })
        
        observeEvent(input$order_complete, {
            shinyjs::hide("overall_form")
            shinyjs::show("quit_msg")
        })
        
        #observeEvent(input$reset, {
            shinyjs::reset("overall_form")
            shinyjs::show("form gen info")
            shinyjs::show("reset_msg")
            shinyjs::hide("thankyou_msg")
        #})
        
        loadData <- function() {
            # Read all the files into a list
            filesInfo <- drop_dir(outputDir)
            filePaths <- filesInfo$path
            data <- lapply(filePaths, drop_read_csv, stringsAsFactors = FALSE)
            # Concatenate all data together into one data.frame
            data <- do.call(rbind, data)
            data
        }
}
)
Solution

  • Looks like there was an update on dropbox's end and the token methodology outlined by Karthik in his README is no longer suitable for long term applications. There are some work arounds that you can find under the following link but hopefully something more permanent is on the way in rdrop2. For now the method provided by Emily-Chai has worked for me and other users.