Working crunchy app

[gergness]

Modern shiny has possibly broken the hooks in crunchyBody and crunchyServer, (though this might be user error). For posterity, this worked for me:

library(shiny)
library(crunch)

httpcache::cacheOff()

js <- r"(
function getToken() {
  var ca = document.cookie.split(';')
  for(var i=0; i < ca.length; i++) {
    var c = $.trim(ca[i])
    if (c.indexOf('token=') === 0) {
      return decodeURIComponent(c.substring(6, c.length))
    }
  }
  return null
}

$(document).on('shiny:connected', function(ev){
  res = getToken()
  Shiny.setInputValue('token', res);
})
)"

ui <- fluidPage(
  tags$head(tags$script(HTML(js))),
  tags$h1("List of datasets"),
  uiOutput("list_datasets"),
)

server <- function(input, output, session){
  output$list_datasets <- renderUI({
    if (is.null(input$token)) return(tags$p("You are not logged in"))
    tokenAuth(input$token)
    do.call(
      tags$ul,
      lapply(listDatasets(), function(x) tags$li(x))
    )
  })
}

shinyApp(ui, server)

[gergness]

And because we now use HttpOnly cookies, this is how to access a token now.

library(shiny)
library(crunch)

httpcache::cacheOff()

set_crunch_opts(crunch.api = "https://team.alpha.crunch.io/api/")

hosted_crunchy_ui <- function(ui) {
    ui_func <- function(req) {
        if (is.function(ui)) ui <- ui(req)
        js <- hosted_crunchy_js(req)
        htmltools::tagInsertChildren(ui, 1, htmltools::tags$head(htmltools::tags$script(htmltools::HTML(js))))
    }
    return(ui_func)
}

hosted_crunchy_js <- function(req) {
    token <- get_token_from_cookie(req$HTTP_COOKIE)
    if (is.null(token)) return(NULL)
    paste0(
        "$(document).on('shiny:connected', function(ev){",
        "Shiny.setInputValue('token', '", token, "');",
        "});"
    )
}

get_token_from_cookie <- function(x) {
    split <- regmatches(x, regexec("token=\\\"(.+?)\\\"", x))
    if (length(split) > 0 && length(split[[1]]) > 1) return(split[[1]][2])
    return(NULL)
}

ui <- function(req) {
    fluidPage(
        tags$h1("API details"),
        tags$p("Current API: ", uiOutput("api_output", inline = TRUE)),
        textInput("new_api", "New API:", envOrOption("crunch.api"),),
        tags$p("Key from cookie: ", uiOutput("token_from_cookie", inline = TRUE)),
        textInput("manual_key", "API key (override):", ),
        actionButton("update_api", "Update API & token override"),
        tags$h1("API Usage:"),
        uiOutput("api_usage")
    )
}


server <- function(input, output, session) {
    autoInvalidate <- reactiveTimer(2000)
    used_token <- reactiveVal(isolate(input$token))

    observeEvent(input$token, {
        used_token(input$token)
    })

    observeEvent(input$update_api, {
        set_crunch_opts(crunch.api = input$new_api)
        if (input$manual_key != "") used_token(input$manual_key) else used_token(input$token)
    })
    output$api_output <- renderUI({
        autoInvalidate()
        envOrOption("crunch.api")
    })
    output$token_from_cookie <- renderUI({
        if (is.null(input$token)) return("<NULL>")
        paste0('"', input$token, '"')
    })
    output$api_usage <- renderUI({
        if (is.null(used_token())) return(tags$p("No token found"))

        tokenAuth(used_token())
        list_of_datasets <- try(listDatasets())
        if (inherits(list_of_datasets, "try-error")) {
            return(tags$p("Failed to tokenAuth to ", envOrOption("crunch.api"), " with token: ", used_token()))
        }

        tagList(
            tags$h2("List of datasets (first 6)"),
            do.call(
                tags$ul,
                lapply(head(list_of_datasets), function(x) tags$li(x))
            )
        )
    })
}

shinyApp(hosted_crunchy_ui(ui), server)