Sketch of shiny + oauth

shiny-oauth.r

library(shiny)
library(httr)
library(shinydashboard)
library(magrittr)
mykey = paste(sample(LETTERS,20,replace = T),collapse="")#should be secret
# OAuth setup --------------------------------------------------------

# Most OAuth applications require that you redirect to a fixed and known
# set of URLs. Many only allow you to redirect to a single URL: if this
# is the case for, you'll need to create an app for testing with a localhost
# url, and an app for your deployed app.

if (interactive()) {
  # testing url
  options(shiny.port = 8100)
  APP_URL <- "http://localhost:8100/"
} else {
  # deployed URL
  APP_URL <- "https://servername/path-to-app"
}

# Note that secret is not really secret, and it's fine to include inline
app <- oauth_app("shinygithub",
                 key = "51d46f96810d1fd182a2",
                 secret = "66eec8782825eeb61007dbef32f91afc9c3587aa",
                 redirect_uri = APP_URL
)

# Here I'm using a canned endpoint, but you can create with oauth_endpoint()
api <- oauth_endpoints("github")

# Always request the minimal scope needed. For github, an empty scope
# gives read-only access to public info
scope <- ""

# Shiny -------------------------------------------------------------------

has_auth_code <- function(params) {
  # params is a list object containing the parsed URL parameters. Return TRUE if
  # based on these parameters, it looks like auth codes are present that we can
  # use to get an access token. If not, it means we need to go through the OAuth
  # flow.
  return(!is.null(params$code))
}

ui <- function(req_txt) {
  fluidPage(
    # Your regular UI goes here, for when everything is properly auth'd
    verbatimTextOutput("code"),
    actionButton("back_to_login","Revenir à la page d'identification",icon=icon("home")),
    textAreaInput("inreq",NULL,value = req_txt,height = "300px")
  )
}

ui_auth <- function(req_txt){
  fluidPage(title = "Connexion",
            fluidRow(
              box(title="Connexion par mot de passe",
                  textInput("user","Identifiant"),
                  passwordInput("pwd","Mot de passe"),
                  actionButton("submit","Soumettre",icon = icon("check")),
                  uiOutput("ui_hasauth"))
            ),
            fluidRow(
              box(title = "Connexion via SSO",
                  actionButton("goSSO","Accéder au SSO"),
                  uiOutput("ui_redirect"))
            ),
            textAreaInput("inreq",NULL,value = req_txt,height = "300px")
  )
}

# A little-known feature of Shiny is that the UI can be a function, not just
# objects. You can use this to dynamically render the UI based on the request.
# We're going to pass this uiFunc, not ui, to shinyApp(). If you're using
# ui.R/server.R style files, that's fine too--just make this function the last
# expression in your ui.R file.
uiFunc <- function(req) {
  req_txt = paste0("REQUEST_METHOD: ",req$REQUEST_METHOD,"\n",
                   "SCRIPT_NAME: ", req$SCRIPT_NAME,"\n",
                   "PATH_INFO: ", req$PATH_INFO,"\n",
                   "QUERY_STRING: ",req$QUERY_STRING,"\n",
                   "SERVER_NAME: ",req$SERVER_NAME,"\n",
                   "SERVER_PORT: ",req$SERVER_PORT,"\n",
                   "HTTP_CONNECTION: ",req$HTTP_CONNECTION,"\n",
                   "HTTP_UPGRADE_INSECURE_REQUESTS: ",req$HTTP_UPGRADE_INSECURE_REQUESTS,"\n",
                   "HTTP_ACCEPT: ",req$HTTP_ACCEPT,"\n",
                   "HTTP_ACCEPT_LANGUAGE: ",req$HTTP_ACCEPT_LANGUAGE,"\n",
                   "HTTP_ACCEPT_ENCODING: ",req$HTTP_ACCEPT_ENCODING,"\n",
                   "HTTP_USER_AGENT: ",req$HTTP_USER_AGENT,"\n",
                   "HTTP_HOST: ",req$HTTP_HOST,"\n"
  )
  print(names(req))
  # browser()
  
  if (!has_auth_code(parseQueryString(req$QUERY_STRING))) {
    ui_auth(req_txt)
  } else {
    ui(req_txt)
  }
}

server <- function(input, output, session) {
  
  
  observeEvent(input$back_to_login,{
    req(input$back_to_login)
    updateQueryString("?",mode="replace",session=session)
    session$reload()
  })
  
  
  output$ui_hasauth = renderUI({
    req(input$submit)
    print("submit")
    req(input$user)
    req(input$pwd)
    if(input$user=="admin" & input$pwd =="azerty"){
      print("auth OK")
      hashcode = safer::encrypt_string(paste0(input$user,input$pwd,'@time:',Sys.time()),key = mykey)
      redirect <- sprintf("location.replace(\"%s\");", paste0(APP_URL,"?code=",hashcode))
      tags$script(HTML(redirect))
      
    }
  })
  
  output$ui_redirect = renderUI({
    print(input$goSSO)
    if(!is.null(input$goSSO)){
      if(input$goSSO>0){
        url <- oauth2.0_authorize_url(api, app, scope = scope)
        redirect <- sprintf("location.replace(\"%s\");", url)
        tags$script(HTML(redirect))
      } else NULL
    } else NULL
  })
  
  
  
  
  
  output$code <- renderText({
    # browser()
    params <- parseQueryString(session$clientData$url_search)
    print(params)
    req(has_auth_code(params))
    # if (!has_auth_code(params)) {
    #   return()
    # }
    
    # Manually create a token
    token <- oauth2.0_token(
      app = app,
      endpoint = api,
      credentials = oauth2.0_access_token(api, app, params$code),
      cache = FALSE
    )
    resp <- GET("https://api.github.com/user", config(token = token))
    print(paste0("status code : ",resp$status_code))
    if(resp$status_code == 200){
      res = content(resp, "text")
    } else {
      # browser()
      #check the token was produced less that 1 minute ago (maybe reduce this time ?)
      has_auth_user_pwd = safer::decrypt_string(params$code,key = mykey) %>% 
        strsplit(split = "@time:") %>% 
        .[[1]] %>% 
        .[2] %>%
        as.POSIXct()
      has_auth_user_pwd = difftime(Sys.time(),has_auth_user_pwd,units = "mins")<1
      if (has_auth_user_pwd){
        res = "Auth with user & password"
      } else {
        res = "Bad auth"
      }
    }
    res
  })
}

# Note that we're using uiFunc, not ui!
shinyApp(uiFunc, server)

We have a local Oauth server setup by IT team. Instead of using github or google oauth, how do I extend this to my local oauth server ?

We have a local Oauth server setup by IT team. Instead of using github or google oauth, how do I extend this to my local oauth server ?

Hello @gadepallivs you just have to create your own api object (line 30) by passing your server endpoints to the oauth_endpoint function. Of course you also need, line 23, the right clientID and secretID related to your app on your oauth server.