Merge pull request #10 from andyquinterom/T7

Adds support for auth0 and fixes bugs

NAMESPACE

@@ -6,6 +6,9 @@ export(expires_in)
 export(get_token_field)
 export(is_expired)
 export(is_valid)
+export(new_auth0_config)
+export(new_entra_id_config)
+export(new_google_config)
 export(new_openid_config)
 export(sso_shiny_app)
 export(token)

R/auth.R

@@ -38,6 +38,20 @@ access_token.entra_id_config <- function(config, token_str) {
   )
 }
 
+#' @keywords internal
+access_token.auth0_config <- function(config, token_str) {
+  token_data <- decode_token(config, token_str)
+  structure(
+    list(
+      access_token = token_str,
+      exp = lubridate::as_datetime(token_data$exp),
+      iat = lubridate::as_datetime(token_data$iat),
+      token_data = token_data
+    ),
+    class = c("auth0_token", "access_token")
+  )
+}
+
 #' @title Print an access token
 #' @description Prints an access token's expiration date
 #'

R/auth0.R

@@ -0,0 +1,216 @@
+#' @keywords internal
+build_auth0_login_url <- function(auth_url, client_id, redirect_uri) {
+  url <- httr2::url_parse(auth_url)
+  url$query <- list(
+    client_id = client_id,
+    redirect_uri = redirect_uri,
+    response_type = "code",
+    scope = "openid email profile"
+  )
+  httr2::url_build(url)
+}
+
+#' @title Create a new auth0_config object
+#' @description Creates a new auth0_config object
+#'
+#' @param client_id The client ID for the app
+#' @param client_secret The client secret for the app
+#' @param auth0_domain The domain for the Auth0 tenant
+#' @param app_url The URL for the app
+#'
+#' @return An auth0_config object
+#' @export
+new_auth0_config <- function(client_id, client_secret, auth0_domain, app_url) {
+  app_url <- add_trailing_slash(app_url)
+  auth_url <- glue::glue("https://{auth0_domain}/authorize")
+  token_url <- glue::glue("https://{auth0_domain}/oauth/token")
+  jwks_url <- glue::glue("https://{auth0_domain}/.well-known/jwks.json")
+  redirect_uri <- build_redirect_uri(app_url)
+  login_url <- build_auth0_login_url(auth_url, client_id, redirect_uri)
+  structure(
+    list(
+      app_url = app_url,
+      client_id = client_id,
+      client_secret = client_secret,
+      redirect_uri = redirect_uri,
+      auth_url = auth_url,
+      token_url = token_url,
+      jwks_url = jwks_url,
+      login_url = login_url,
+      jwks = fetch_jwks(jwks_url)
+    ),
+    class = c("auth0_config", "openid_config")
+  )
+}
+
+#' @keywords internal
+get_login_url.auth0_config <- function(config) {
+  config$login_url
+}
+
+#' @keywords internal
+get_logout_url.auth0_config <- function(config) {
+  stop("Not implemented")
+}
+
+#' @keywords internal
+request_token.auth0_config <- function(config, authorization_code) {
+  res <- httr2::request(config$token_url) |>
+    httr2::req_method("POST") |>
+    httr2::req_body_form(
+      code = authorization_code,
+      client_id = config$client_id,
+      client_secret = config$client_secret,
+      grant_type = "authorization_code",
+      redirect_uri = config$redirect_uri
+    ) |>
+    httr2::req_perform()
+  resp_status <- httr2::resp_status(res)
+  if (resp_status != 200) {
+    stop(httr2::resp_body_string(res))
+  }
+  resp_body <- httr2::resp_body_json(res)
+  access_token(config, resp_body$id_token)
+}
+
+#' @keywords internal
+decode_token.auth0_config <- function(config, token) {
+  decoded <- config$jwks |>
+    purrr::map(function(jwk) {
+      tryCatch(
+        jose::jwt_decode_sig(token, jwk),
+        error = function(e) {
+          NULL
+        }
+      )
+    }) |>
+    purrr::discard(is.null) |>
+    purrr::pluck(1, .default = NULL)
+  if (is.null(decoded)) {
+    stop("Unable to decode token")
+  }
+  return(decoded)
+}
+
+#' @keywords internal
+get_client_id.auth0_config <- function(config) {
+  config$client_id
+}
+
+#' @keywords internal
+shiny_app.auth0_config <- function(config, app) {
+  app_handler <- app$httpHandler
+  login_handler <- function(req) {
+
+    # If the user sends a POST request to /login, we'll get a code
+    # and exchange it for an access token. We'll then redirect the
+    # user to the root path, setting a cookie with the access token.
+    if (req$PATH_INFO == "/login") {
+      query <- shiny::parseQueryString(req$QUERY_STRING)
+      token <- promises::future_promise({
+        request_token(config, query[["code"]])
+      })
+      return(
+        promises::then(
+          token,
+          onFulfilled = function(token) {
+            shiny::httpResponse(
+              status = 302,
+              headers = list(
+                Location = config$app_url,
+                "Set-Cookie" = build_cookie("access_token", get_bearer(token))
+              )
+            )
+          },
+          onRejected = function(e) {
+            shiny::httpResponse(
+              status = 302,
+              headers = list(
+                Location = config$app_url,
+                "Set-Cookie" = build_cookie("access_token", "")
+              )
+            )
+          }
+        )
+      )
+    }
+
+    if (req$PATH_INFO == "/logout") {
+      return(
+        shiny::httpResponse(
+          status = 302,
+          headers = list(
+            Location = config$app_url,
+            "Set-Cookie" = build_cookie("access_token", "")
+          )
+        )
+      )
+    }
+
+    # Get eh HTTP cookies from the request
+    cookies <- parse_cookies(req$HTTP_COOKIE)
+
+    # If the user requests the root path, we'll check if they have
+    # an access token. If they don't, we'll redirect them to the
+    # login page.
+    if (req$PATH_INFO == "/") {
+      token <- tryCatch(
+        expr = access_token(config, remove_bearer(cookies$access_token)),
+        error = function(e) {
+          return(NULL)
+        }
+      )
+      if (is.null(token)) {
+        return(
+          shiny::httpResponse(
+            status = 302,
+            headers = list(
+              Location = get_login_url(config)
+            )
+          )
+        )
+      }
+    }
+
+    # If the user requests any other path, we'll check if they have
+    # an access token. If they don't, we'll return a 403 Forbidden
+    # response.
+    token <- tryCatch(
+      expr = access_token(config, remove_bearer(cookies$access_token)),
+      error = function(e) {
+        return(NULL)
+      }
+    )
+
+    if (is.null(token)) {
+      return(
+        shiny::httpResponse(
+          status = 403,
+          content_type = "text/plain",
+          content = "Forbidden"
+        )
+      )
+    }
+
+    # If we have reached this point, the user has a valid access
+    # token and therefore we can return NULL, which will cause the
+    # app handler to be called.
+    return(NULL)
+  }
+
+  handlers <- list(
+    login_handler,
+    app_handler
+  )
+
+  app$httpHandler <- function(req) {
+    for (handler in handlers) {
+      response <- handler(req)
+      if (!is.null(response)) {
+        return(response)
+      }
+    }
+  }
+
+  return(app)
+}

R/config.R

@@ -10,7 +10,8 @@ fetch_jwks <- function(url) {
 
 #' @title New openid configuration
 #' @description Creates a new openid configuration object
-#'   for the given provider
+#'   for the given provider. You can use this function or
+#'   the individual provider functions.
 #'
 #' @param provider The openid provider to use
 #' @param app_url The URL of the application
@@ -27,12 +28,18 @@ fetch_jwks <- function(url) {
 #'   - `client_secret`
 #'   - `tenant_id`
 #'
+#'   The `"auth0"` provider accepts the following arguments:
+#'   - `client_id`
+#'   - `client_secret`
+#'   - `auth0_domain`
+#'
 #' @return An openid_config object
 #' @export
 new_openid_config <- function(provider, app_url, ...) {
   switch(provider,
     entra_id = new_entra_id_config(app_url = app_url, ...),
-    google = new_google_config(app_url = app_url, ...)
+    google = new_google_config(app_url = app_url, ...),
+    auth0 = new_auth0_config(app_url = app_url, ...),
   )
 }
 

R/entra_id.R

@@ -14,7 +14,16 @@ build_entra_id_login_url <- function(auth_url, client_id, redirect_uri) {
   httr2::url_build(url)
 }
 
-#' @keywords internal
+#' @title Create a new entra_id_config object
+#' @description Creates a new entra_id_config object
+#'
+#' @param tenant_id The tenant ID for the app
+#' @param client_id The client ID for the app
+#' @param client_secret The client secret for the app
+#' @param app_url The URL for the app
+#'
+#' @return An entra_id_config object
+#' @export
 new_entra_id_config <- function(tenant_id, client_id, client_secret, app_url) {
   app_url <- add_trailing_slash(app_url)
   auth_url <- glue::glue("{ENTRA_ID_BASE_URL}/{tenant_id}/oauth2/v2.0/authorize")

R/google.R

@@ -11,7 +11,15 @@ build_google_login_url <- function(auth_url, client_id, redirect_uri) {
   httr2::url_build(url)
 }
 
-#' @keywords internal
+#' @title Create a new google_config object
+#' @description Creates a new google_config object
+#'
+#' @param client_id The client ID for the app
+#' @param client_secret The client secret for the app
+#' @param app_url The URL for the app
+#'
+#' @return A google_config object
+#' @export
 new_google_config <- function(client_id, client_secret, app_url) {
   app_url <- add_trailing_slash(app_url)
   auth_url <- "https://accounts.google.com/o/oauth2/v2/auth"

R/utils.R

@@ -46,6 +46,27 @@ build_cookie <- function(key, value) {
   glue::glue("{key}={value}; path=/; SameSite=Lax; HttpOnly")
 }
 
+map_null <- function(x, f) {
+  if (is.null(x)) {
+    return(NULL)
+  }
+  return(f(x))
+}
+
+add_trailing_slash_to_path <- function(path) {
+  if (!stringr::str_ends(path, "/")) {
+    path <- glue::glue("{path}/")
+  }
+  return(path)
+}
+
+if_length_0 <- function(x, y) {
+  if (length(x) == 0) {
+    return(y)
+  }
+  return(x)
+}
+
 #' @title Add trailing slash to URL
 #' @description If the app URL does not end with a slash, this function
 #'   will add one.
@@ -56,10 +77,9 @@ build_cookie <- function(key, value) {
 #' @keywords internal
 add_trailing_slash <- function(url) {
   url <- httr2::url_parse(url)
-  path <- url$path
-  if (!stringr::str_ends(path, "/")) {
-    url$path <- glue::glue("{path}/")
-  }
+  url$path <- url$path |>
+    map_null(add_trailing_slash_to_path) |>
+    if_length_0("/")
   httr2::url_build(url)
 }
 

_pkgdown.yml

@@ -1,3 +1,27 @@
 url: ~
 template:
   bootstrap: 5
+reference:
+- title: Provider configurations
+  desc: Setup an authentication provider
+- contents:
+  - new_openid_config
+  - new_google_config
+  - new_entra_id_config
+  - new_auth0_config
+- title: Work with token
+  desc: Interact with the authentication token
+- contents:
+  - get_token_field
+  - expires_at
+  - expires_in
+  - is_expired
+  - is_valid
+- title: Shiny
+  desc: Functions to use inside Shiny
+- contents:
+  - sso_shiny_app
+  - token
+- title: S3 methods
+- contents:
+  - print.access_token