How to block or restrict access when a user is already using a Shiny app

Question

I have a Shiny app that uses the Ace editor. Now I would like to have it so that when a first user is using this editor, other users cannot edit the document, but only view the document.

How can this be realized?

The code is:

library(shiny)
library(shinyAce)
library(stringi)

ui <- fluidPage(
  br(),
  uiOutput("aceEditor1"),
  downloadButton('save1', 'Save editor content')
)

server <- function(input, output, session)
{
  output$aceEditor1 <- renderUI(
  {
    aceEditor(outputId = "ace1", 
              value = paste(stri_rand_lipsum(3), collapse="\n\n"),
              mode = "r", 
              height = "500px", 
              fontSize = 17, 
              theme = "chrome", 
              wordWrap = TRUE)
  })

  output$save1 <- downloadHandler (
    filename = function() 
    { 
      "result.txt" 
    },

    content = function(file) 
    { 
       write.table(x = input$ace1, file = file, sep = "", row.names = FALSE, col.names = FALSE, quote = FALSE) 
    }
  )
}

shinyApp(ui = ui, server = server)

Answer 1

You can implement this by introducing keys. Essentially, we create a global key variable which is visible to all sessions. When a session starts it takes the key and sets the global variable to be unavailable.

When a new session connects, and attempts to get the key, but it is unavailable.

Within the server function we can check before executing a "critical section" piece of code.

This is essentially the basics of how semiphore flag work.

Finally, when the session ends for the first session, it returns the key to the global variable.

We can also go a step further and use invalidateLater() to periodically check if the key is available.

To run the dummy example below first run this,

write_csv(mtcars,"~/Desktop/data.csv")

And the app is the following:

library(shiny)


key_available <- TRUE

ui <- fluidPage(
  br(),
  textInput(inputId = "text_input","Text Input"),
  actionButton(inputId = "add_col","Add Column"),
  dataTableOutput("table_output"),
  downloadButton('save1', 'Save editor content')
)

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

  onSessionEnded(function() key_available <<- TRUE)

  # Session starts, Read data in
  have_key <- FALSE

  observe({
    invalidateLater(1000)

    if(key_available){
      key_available <<- FALSE
      have_key <<- TRUE
    }

  })

  data_reactive <- eventReactive(c(input$add_col),{
    data <- read_csv("~/Desktop/data.csv")
    if(have_key){
      data[[input$text_input]] <- NA
      write_csv(data,"~/Desktop/data.csv")
    }

    return(data)
  })


  output$table_output <- renderDataTable({
    req(data_reactive())
    data_reactive()
    })


}

shinyApp(ui = ui, server = server)

Open the first browser window, add a column name in the text box and click on Add Column.

You will notice the column is added. You can continue to do this as this session has the key.

Opening a new browser window simultaneously, and trying to do the above will be unsuccessful. However, if you close the first browser window, you will be able to now edit on the second browser window.