ShinyFriendlyCaptcha and Jsolinte dont work

Question

I want to put a captcha in my shiny app. I used ShinyFriendlyCaptcha package. This is my MWE. It shows only the captcha. It works well:

library(shiny)
library(ShinyFriendlyCaptcha)#devtools::install_github("mhanf/ShinyFriendlyCaptcha")
# UI

ui<-fluidPage(
  sfc_output(
    id = "test",
    sitekey = 'FCMLPPDE8H8IO645',
    lang = "en",
    dark_mode = FALSE,
    eu_endpoint = FALSE,
    theme_bs5 = TRUE
  )
)

# Server
server <- function(input, output) {
  # shinyvalidate
  
  # captcha response
  captcha_result <- sfc_server(
    id = "test",
    secret = 'A1T24PTUO6EU091S3HVJC3FRN5UE3JPBQ6UDO3RI3R5NM3VE4J6AQ0A8HC',
    sitekey = 'FCMLPPDE8H8IO645',
    eu_endpoint = FALSE
  )
  
}
# Run the application
shinyApp(ui = ui, server = server)

Now, I need to build the UI dynamically:

library(shiny)
library(ShinyFriendlyCaptcha)#devtools::install_github("mhanf/ShinyFriendlyCaptcha")

ui<-uiOutput("body")

# Server
server <- function(input, output) {

  # captcha response
  captcha_result <- sfc_server(
    id = "test",
    secret = 'A1T24PTUO6EU091S3HVJC3FRN5UE3JPBQ6UDO3RI3R5NM3VE4J6AQ0A8HC',
    sitekey = 'FCMLPPDE8H8IO645',
    eu_endpoint = FALSE
  )
      
  output$body <- renderUI({
    fluidPage(
      sfc_output(
        id = "test",
        sitekey = 'FCMLPPDE8H8IO645',
        lang = "en",
        dark_mode = FALSE,
        eu_endpoint = FALSE,
        theme_bs5 = TRUE
      )
    )
  })
}
# Run the application
shinyApp(ui = ui, server = server)

This code does not show anything (the app does not fail), and this message appears in the console:

Listening on http://127.0.0.1:5396
Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.

I found a similar question here, but it does not help. Any idea how to solve it?

Answer 1

The problem is that ShinyFriendlyCaptcha::sfc_output loads some JavaScript which fires when document.readyState does not equal loading anymore. With a dynamic UI, this state is achieved before you try to add your captcha (basically once the static UI is loaded).

Thus, all the setup code won't run, because the JS looks for the appropriate div which it cannot find.

You see that the JavaScript is executed too early if you open the developer console:

With the way how sfc_output is currently implemented, I guess you have no luck using it dynamically.

A crude workaround would be to split the HTML and the JS dependencies and use insertUI to insert them one after the other:

sfc_output2 <- function (id, sitekey = Sys.getenv("captcha_sitekey"), lang = "en", 
    eu_endpoint = FALSE, theme_bs5 = FALSE, dark_mode = FALSE) {
    bs5_dep <- NULL
    if (isTRUE(theme_bs5)) {
        bs5_dep <- htmlDependency(name = "bs5_dep", version = "0.0.1", 
            package = "ShinyFriendlyCaptcha", src = "assets", 
            stylesheet = c(file = "bs5_style.css"))
        bs5_dep <- tags$style(id = "frc-style", bs5_dep)
    }
    ns <- NS(id)
    language <- c("en", "fr", "de", "it", "nl", "pt", "es", "ca", 
        "da", "ja", "ru", "sv", "el", "uk", "bg", "cs", "sk", 
        "no", "fi", "lt", "lt", "pl", "et", "hr", "sr", "sl", 
        "hu", "ro", "zh", "zh_TW", "vi")
    match.arg(arg = lang, choices = language, several.ok = FALSE)
    captcha_js1 <- htmltools::htmlDependency(name = "friendlyCaptcha1", 
        version = "0.9.10", package = "ShinyFriendlyCaptcha", 
        src = "assets", script = "widget.module.min.js", )
    captcha_js2 <- htmltools::htmlDependency(name = "friendlyCaptcha2", 
        version = "0.9.10", package = "ShinyFriendlyCaptcha", 
        src = "assets", script = "widget.min.js")
    captcha_js3 <- tags$script(paste0("shinyCaptcha = function(response) {\n      Shiny.onInputChange('", 
        ns("captcha_response"), "', response);\n             }"))
    captcha_class <- "frc-captcha"
    if (isTRUE(dark_mode)) {
        captcha_class <- sprintf("%s dark", captcha_class)
    }
    endpoint <- "https://api.friendlycaptcha.com/api/v1/puzzle"
    if (isTRUE(eu_endpoint)) {
        endpoint <- "https://eu-api.friendlycaptcha.eu/api/v1/puzzle"
    }
    captcha <- div(class = captcha_class, `data-lang` = lang, 
        `data-sitekey` = sitekey, `data-callback` = I("shinyCaptcha"), 
        `data-puzzle-endpoint` = endpoint)
    deps <- tagList(bs5_dep, captcha_js1, captcha_js2, captcha_js3)
    input_captcha <- checkboxInput(inputId = ns("captchaId"), 
        label = NULL, value = FALSE)
    input_captcha <- tagAppendAttributes(input_captcha, .cssSelector = "div", 
        style = "display:none;")
    captcha <- tagInsertChildren(input_captcha, after = 1, captcha)
    list(cap = captcha, deps = deps)
}

Then you can use sfc_output2 like this:

library(ShinyFriendlyCaptcha)
library(htmltools)

ui<- fluidPage(
  div(id = "mother")
)

# Server
server <- function(input, output, session) {

  # captcha response
  captcha_result <- sfc_server(
    id = "test",
    secret = 'A1T24PTUO6EU091S3HVJC3FRN5UE3JPBQ6UDO3RI3R5NM3VE4J6AQ0A8HC',
    sitekey = 'FCMLPPDE8H8IO645',
    eu_endpoint = FALSE
  )

  cap <- sfc_output2(
    id = "test",
    sitekey = 'FCMLPPDE8H8IO645',
    lang = "en",
    dark_mode = FALSE,
    eu_endpoint = FALSE,
    theme_bs5 = TRUE
  )

  insertUI("#mother", "afterBegin", cap$cap)
  insertUI("#mother", "afterBegin", cap$deps)
}
# Run the application
shinyApp(ui = ui, server = server)