Persistent Authentification Requirement-API Request Authetification Repitition
Closed this issue · 0 comments
Hi,
I am attempting to save out some information for what I've built the framework for. I want everything working before I populate it with questions and choices. In a seperate file, I run:
library(shiny)
library(rdrop2)
token <- drop_auth()
saveRDS(token, "droptoken.rds")
token <- readRDS("droptoken.rds")
drop_acc(dtoken = token)
Once I do this, I attempt to run this code:
library(shiny)
library(shinydashboard)
library(rdrop2)
fields <- c("choice", "choice1", "choice2", "choice3", "choice 4", "radio1", "radio2", "radio3")
ui <- dashboardPage(skin = "blue",
dashboardHeader(
title= strong("Content")
),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")
),
menuItem("Question Type One", tabName = "pls", icon = icon("question-circle"),
menuSubItem("Question 1", tabName = "q_3", icon = icon("long-arrow-alt-right"))
),
menuItem("Question Type Two", tabName = "more", icon = icon("question-circle"))
)
),
dashboardBody(
DT::dataTableOutput("responses", width = 300), tags$hr(),
tabItems(
tabItem(tabName = "dashboard", uiOutput("panel1"),
h2("Placeholder for directions and any other general statements.",
br(),
br(),
fluidRow(
tabBox(
title = "Info",
id = "tabset1", height = NULL
)
)
)
),
tabItem(tabName = "q_3", uiOutput("panel2"),
fluidRow(box(height=NULL, width=12, h3("-"), align="center")),
fluidRow(box(height=1,width=1),
box(height=NULL,width=2,tags$img(src='test.png', height=225, width=225, style="display: block; margin-left: auto; margin-right: auto;")),
box(height=NULL,width=2,tags$img(src='test.png', height=225, width=225, style="display: block; margin-left: auto; margin-right: auto;")),
box(height=NULL,width=2,tags$img(src='test.png', height=225, width=225, style="display: block; margin-left: auto; margin-right: auto;")),
box(height=NULL,width=2,tags$img(src='test.png', height=225, width=225, style="display: block; margin-left: auto; margin-right: auto;")),
box(height=NULL,width=2,tags$img(src='test.png', height=225, width=225, style="display: block; margin-left: auto; margin-right: auto;")),
box(height=1, width=1)),
fluidRow(box(height=1,width=1),box(height=NULL, width=2, selectInput("choice", "Choose an answer:",
list("1 (-)"=1, "2", "3", "4 (-)"=4))),
box(height=NULL, width=2, selectInput("choice1", "Choose an answer:",
list("1 (-)"=1, "2", "3", "4 (-)"=4))),
box(height=NULL, width=2, selectInput("choice2", "Choose an answer:",
list("1 (-)"=1, "2", "3", "4 (-)"=4))),
box(height=NULL, width=2, selectInput("choice3", "Choose an answer:",
list("1 (-)"=1, "2", "3", "4 (-)"=4))),
box(height=NULL, width=2, selectInput("choice4", "Choose an answer:",
list("1 (-)"=1, "2", "3", "4 (-)"=4))), box(height=1, width=1)),
fluidRow(box(height=1,width=12))
),
tabItem(tabName = "more", uiOutput("panel3"),
fluidRow(box(height=NULL, width=12,h3("-.
"), align="center")),
fluidRow(box(height=1,width=1), box(height=175, width=2, radioButtons("radio1", label = strong("-"),
choices = list("-" = 1, "-----" = 2, "Moderate Complexity" = 3, "-----" = 4, "-" = 5),
selected = 1)),
box(height=NULL, width=3, solidHeader = TRUE, tags$img(src='test.png', height=350, width=350, style="display: block; margin-left: auto; margin-right: auto;")),
box(height=NULL, width=3, solidHeader = TRUE, tags$img(src='test.png', height=350, width=350, style="display: block; margin-left: auto; margin-right: auto;")), box(height=175, width=2, radioButtons("radio2", label = strong("-"),
choices = list("-" = 1, "-----" = 2, "-" = 3, "-----" = 4, "-" = 5),
selected = 1)), box(height=1, width=1)),
fluidRow(box(height=1, width=3), box(height= NULL, width=6, strong("-."), align="center"), box(height=1, width=3)),
fluidRow(box(height=1, width=2), box(height=NULL, width=8, radioButtons("radio3", label = NULL, choices = list("-" = 1, "-" = 2, "-" = 3, "-" = 4, "-" = 5),
selected = 1, inline=TRUE), align="center"), box(height=1, width=2)),
actionButton("submit", "Submit", icon("paper-plane"), class = "btn-danger", style="float:right;text-align:center"),
fluidRow(box(height=1, width=12)))
)
)
)
server <- shinyServer(function(input, output, session) {
Whenever a field is filled, aggregate all form data
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data
})
When the Submit button is clicked, save the form data
observeEvent(input$submit, {
saveData(formData())
})
Show the previous responses
(update with current response when Submit is clicked)
output$responses <- DT::renderDataTable({
input$submit
loadData()
})
saveData <- function(data) {
data <- as.data.frame(t(data))
if (exists("responses")) {
responses <<- rbind(responses, data)
} else {
responses <<- data
}
}
loadData <- function() {
if (exists("responses")) {
responses
}
}
outputDir <- "responses"
saveData <- function(data) {
data <- t(data)
# Create a unique file name
fileName <- sprintf("%s_%s.csv", as.integer(Sys.time()), digest::digest(data))
# Write the data to a temporary file locally
filePath <- file.path(tempdir(), fileName)
write.csv(data, filePath, row.names = FALSE, quote = TRUE)
# Upload the file to Dropbox
drop_upload(filePath, path = outputDir)
}
}
)
shinyApp(ui, server)
I expect that it only asks me once to verify my login information and for it to work afterwards. This code breaks very often for the output. It asks me to click allow every time I press Submit and never saves out the csv file remotely (when I click my action button).
What is wrong with my code that's asking me to re authenticate my access?
Furthermore, when it works the app doesn't close out. It remains open, which allows Submit to be clicked an infinite number of times. Can someone please help me with both of these issues?
Thanks so much,
Nathan