R/auth.R

In searchdiscovery/cjar: R Client for 'Customer Journey Analytics' ('CJA') API

# General auth -------------------------------------------------

#' Generate an access token for the Customer Journey Analytics API
#'
#' **Note:** `cja_auth()` is the primary function used for authorization. `auth_s2s()`
#' and `auth_jwt()` should typically not be called directly.
#'
#' @param type Either 'jwt' or 's2s' (default). This can be set explicitly, but a best practice is
#' to run `cja_auth_with()` to set the authorization type as an environment variable before
#' running `cja_auth()`
#' @param ... Additional arguments passed to auth functions.
#' @param client_id The client ID, defined by a global variable or manually defined
#' @param client_secret The client secret, defined by a global variable or manually defined
#' @param file A JSON file containing service account credentials required for JWT
#' authentication. This file can be downloaded directly from the Adobe Console,
#' and should minimally have the fields `API_KEY` or `CLIENT_ID`, `CLIENT_SECRET`, `ORG_ID`,
#' and `TECHNICAL_ACCOUNT_ID`.
#' @param private_key Filename of the private key for JWT authentication.
#' @param jwt_token _(Optional)_ A custom, encoded, signed JWT claim. If used,
#'   `client_id` and `client_secret` are still required.
#' @param s2s_token _(Optional)_ A custom, encoded, signed JWT claim. If used,
#'   `client_id` and `client_secret` are still required.
#' @param use_oob if `FALSE`, use a local webserver for the OAuth dance.
#'   Otherwise, provide a URL to the user and prompt for a validation code.
#'   Defaults to the value of the `httr_oob_default` default, or TRUE if
#'   `httpuv` is not installed.
#'
#' @seealso [cja_auth_with()]
#'
#' @return The path of the cached token. This is returned invisibly.
#' @family auth
#' @aliases cja_auth auth_jwt auth_oauth
#' @export
cja_auth <- function(type = 's2s', ...) {

  if (is.null(type)) {
    stop("Authentication type missing, please set an auth type with `cja_auth_with`")
  }
  type <- match.arg(type, c("jwt", "oauth", 's2s'))

  cja_auth_with(type)

  switch(type,
         jwt = auth_jwt(...),
         oauth = auth_oauth(...),
         s2s = auth_s2s(...)
  )
}

#' Set authorization options
#'
#' @description
#' **Get** or **set** various authorization options. If called without an argument, then
#' these functions return the current setting for the requested option (which can be
#' `NULL` if the option has not been set). To clear the setting, pass `NULL` as an
#' argument.
#'
#' `cja_auth_with` sets the type of authorization for the session. This is used
#' as the default by `cja_auth()` when no specific option is given.
#'
#' @param type The authorization type: 's2s'
#' @param path The location for the cached authorization token. It should be a
#' directory, rather than a filename. If this option is not set, the current
#' working directory is used instead. If the location does not exist, it will
#' be created the first time a token is cached.
#' @param name The filename, such as `cja_auth.rds` for the cached authorization
#' token file. The file is stored as an RDS file, but there is no requirement
#' for the `.rds` file extension. `.rds` is not appended automatically.
#'
#' @seealso [cja_auth()]
#' @return The option value, invisibly
#' @family options
#' @rdname cja_auth_with
#' @aliases cja_auth_with cja_auth_path cja_auth_name
#' @export
cja_auth_with <- function(type = 's2s') {
  if (missing(type)) return(getOption("cjar.auth_type"))

  if (!is.null(type)) {
    type <- match.arg(type, c("oauth", "jwt", "s2s"))
  }

  options(cjar.auth_type = type)
  invisible(type)
}

#' @description
#' `cja_auth_path` sets the file path for the cached authorization token. It
#' should be a directory, rather than a filename. If this option is not set, the
#' current working directory is used instead.
#'
#' @rdname cja_auth_with
#' @family options
#' @export
cja_auth_path <- function(path) {
  if (missing(path)) return(getOption("cjar.auth_path"))
  options(cjar.auth_path = path)
  invisible(path)
}

#' @description
#' `cja_auth_name` sets the file name for the cached authorization token. If this
#' option is not set, the default filename is `cja_auth.rds`
#'
#' @rdname cja_auth_with
#' @family options
#' @export
cja_auth_name <- function(name) {
  if (missing(name)) return(getOption("cjar.auth_name"))
  options(cjar.auth_name = name)
  invisible(name)
}

#' Retrieve a token
#'
#' Updates (if necessary) and returns a session token. This function first checks
#' for a session token, then for a cached token, and, finally, generates a
#' new token. The default type may be set for the session with `cja_auth_with()`.
#'
#' @param ... Further arguments passed to auth functions
#'
#' @importFrom rlang %||%
#' @keywords internal
#' @return A token object of type `response` (JWT) or `Token2.0` (OAuth)
retrieve_cja_token <- function(...) {
  # Check session token
  token <- .cjar$token
  type <- token_type(token) %||% cja_auth_with()

  if (!is.null(token) & !is.null(type)) {
    if (type != token_type(token)) {
      stop("Token type mismatch, malformed session token/type relationship")
    }
  }

  # Session token > cached token > generating new token
  if (is.null(token)) {
    path <- token_path(getOption("cjar.auth_name", "cja_auth.rds"))
    cached_token_exists <- file.exists(path)

    if (cached_token_exists && type == "oauth") {
      message(paste("Retrieving cached token:", path))
      token <- readRDS(path)
      type <- token_type(token)

      .cjar$token <- token
    } else {
      message("No session token or cached token -- generating new token")
      cja_auth(type = cja_auth_with(), ...)
      token <- .cjar$token
      type <- cja_auth_with()
    }
  }

  # Check expiration
  if(type == 'jwt'){
    if (!token$validate()) {
      # This might be the wrong thing to do with OAuth, but it's the right
      # thing to do for JWT
      .cjar$token$refresh()
    }
  } else if(type == 's2s') {
    if (!token$validate()) {
      .cjar$token$refresh()
    }
  }

  return(.cjar$token)
}


#' Standard location for token caching
#'
#' The default path for the token is the current working directory, but
#' the option `cjar.auth_path` overrides this behavior.
#'
#' @param ... Passed to file.path, usually a filename
#'
#' @return File path
#' @noRd
token_path <- function(...) {
  loc <- getOption("cjar.auth_path", getwd())
  file.path(loc, ...)
}

#' Get type of token
#'
#' In the future, this could become a custom object, but for now there
#' are too many differences between the token types, so I just check for
#' each class.
#'
#' @param token An `httr` `reponse` object or `oauth2.0_token` object
#'
#' @return Either 's2s' or 'oauth'
#'
#' @noRd
token_type <- function(token) {
  if (inherits(token, "Token2.0")) {
    "oauth"
  } else if (inherits(token, "AdobeJwtToken")) {
    "jwt"
  } else if (inherits(token, 'AdobeS2SToken')) {
    's2s'
  } else if (is.null(token)) {
    NULL
  } else {
    stop("Unknown token type")
  }
}


#' Get token configuration for requests
#'
#' Returns a configuration for `httr::GET` for the correct token type.
#'
#' @param client_id Client ID
#' @param client_secret Client secret
#'
#' @return Config objects that can be passed to `httr::GET` or similar
#' functions (e.g. `httr::RETRY`)
#'
#' @noRd
get_token_config <- function(client_id,
                             client_secret) {
  token <- retrieve_cja_token(client_id,
                             client_secret)
  type <- token_type(token)

  switch(type,
         oauth = httr::config(token = token),
         jwt = httr::add_headers(Authorization = paste("Bearer", content(token$token)$access_token)),
         s2s = httr::add_headers(Authorization = paste("Bearer", token$token$access)),
         stop("Unknown token type")
  )
}



#' Get user's credentials
#'
#' The order of precedence is:
#'
#' 1. Variables set by auth functions
#' 2. If auth functions haven't been called, use environment variables
#' 3. If environment variables are empty, throw an error
#'
#' @return List of length two with elements `client_id` and `client_secret`
#' @noRd
get_env_vars <- function(type = cja_auth_with()) {
  if(type == 'oauth' || type == 'jwt') {
    client_id <- .cjar$client_id
    client_secret <- .cjar$client_secret
    org_id <- .cjar$org_id

    if (is.null(client_id) | is.null(client_secret) | is.null(org_id)) {
      client_id <- Sys.getenv("CJA_CLIENT_ID")
      client_secret <- Sys.getenv("CJA_CLIENT_SECRET")
      org_id <- Sys.getenv("CJA_ORG_ID")
    }

    if (client_id == "" | client_secret == "" | org_id == "") {
      # env_vars <- c(client_id = client_id,
      #               client_secret = client_secret,
      #               org_id = org_id)
      #
      # missing_envs <- names(env_vars[env_vars == ""])

      stop("Variable 'CJA_AUTH_FILE' not found but required for JWT authentication.\nSee `?cja_auth`",
           call. = FALSE)
    }

    list(
      client_id = client_id,
      client_secret = client_secret,
      org_id = org_id
    )
  } else if(type == 's2s') {
    client_id <- .cjar$client_id
    client_secret <- .cjar$client_secret
    org_id <- .cjar$org_id

    if (is.null(client_id) | is.null(client_secret) | is.null(org_id)) {
      secrets <- jsonlite::fromJSON(Sys.getenv("CJA_AUTH_FILE"))
      client_id <- secrets$CLIENT_ID
      client_secret <-  secrets$CLIENT_SECRETS
      org_id <- secrets$ORG_ID
    }
    list(
      client_id = client_id,
      client_secret = client_secret,
      org_id = org_id
    )
  }
}



# JWT ------------------------------------------------------------------

#' @family auth
#' @describeIn cja_auth Authenticate with JWT token
#' @importFrom openssl read_key
#' @export
auth_jwt <- function(file = Sys.getenv("CJA_AUTH_FILE"),
                     private_key = Sys.getenv("CJA_PRIVATE_KEY"),
                     jwt_token = NULL,
                     ...) {
  if (file == "") {
    if (Sys.getenv("CJA_TECHNICAL_ID") != "" | Sys.getenv("CJA_ORGANIZATION_ID") != "") {
      stop("Using separate environment variables for JWT auth is deprecated.\nUse file-based authentication instead. See `?cja_auth`.")
    }
    stop("Variable 'CJA_AUTH_FILE' not found but required for default JWT authentication.\nSee `?cja_auth`")
  }

  secrets <- jsonlite::fromJSON(file)

  cja_auth_with('jwt')

  resp <- auth_jwt_gen(secrets = secrets, private_key = private_key, jwt_token = jwt_token)


  # If successful
  message("Successfully authenticated with JWT: access token valid until ",
          resp$date + httr::content(resp)$expires_in / 1000)

  .cjar$token <- AdobeJwtToken$new(resp, secrets)
  .cjar$client_id <- secrets$API_KEY
  .cjar$client_secret <- secrets$CLIENT_SECRET
  .cjar$org_id <- secrets$ORG_ID
}

#' Generate the authorization response object
#'
#' @param secrets List of secret values, see `auth_jwt`
#' @param private_key Filename of the private key file
#' @param jwt_token Optional, a JWT token (e.g., a cached token)
#'
#' @noRd
auth_jwt_gen <- function(secrets,
                         private_key,
                         jwt_token = NULL) {

  stopifnot(is.character(secrets$API_KEY))
  stopifnot(is.character(secrets$CLIENT_SECRET))
  stopifnot(is.character(secrets$ORG_ID))
  stopifnot(is.character(secrets$TECHNICAL_ACCOUNT_ID))

  if (any(c(secrets$API_KEY, secrets$CLIENT_SECRET) == "")) {
    stop("Client ID or Client Secret not found.")
  }

  private_key <- openssl::read_key(file = private_key)


  jwt_token <- get_jwt_token(jwt_token = jwt_token,
                             client_id = secrets$API_KEY,
                             private_key = private_key,
                             org_id = secrets$ORG_ID,
                             tech_id = secrets$TECHNICAL_ACCOUNT_ID)


  token <- httr::POST(url="https://ims-na1.adobelogin.com/ims/exchange/jwt",
                      body = list(
                        client_id = secrets$API_KEY,
                        client_secret = secrets$CLIENT_SECRET,
                        jwt_token = jwt_token
                      ),
                      encode = 'form')

  httr::stop_for_status(token)
  token
}

#' Get an encoded, signed JWT token
#'
#' Gets a JWT token
#'
#' @param jwt_token Optional, a JWT token
#' @param client_id Client ID
#' @param private_key File path to private key for token signature
#' @param org_id Organization ID from integration console
#' @param tech_id Technical account ID from integration console
#'
#' @return A JWT token generated by [jose::jwt_encode_sig()]
#' @noRd
get_jwt_token <- function(jwt_token = NULL,
                          client_id,
                          private_key,
                          org_id,
                          tech_id) {
  if (is.null(jwt_token)) {
    if (any(c(org_id, tech_id, private_key) == "")) {
      stop("Missing one of org_id, tech_id, or private_key")
    }

    if (!(inherits(private_key, "key") || file.exists(private_key))) {
      stop("Invalid private key. Is private key a file or the result of `openssl::read_key`?")
    }

    jwt_claim <- jose::jwt_claim(
      exp = as.integer(as.POSIXct(Sys.time() + as.difftime(1, units = "mins"))),
      iss = org_id,
      sub = tech_id,
      aud = paste0('https://ims-na1.adobelogin.com/c/', client_id),
      # Metascope for AA
      "https://ims-na1.adobelogin.com/s/ent_analytics_bulk_ingest_sdk" = FALSE,
      # Metascope for AEP
      "https://ims-na1.adobelogin.com/s/ent_dataservices_sdk" = TRUE,
      # Metascope for CJA
      "https://ims-na1.adobelogin.com/s/ent_cja_sdk" = TRUE

    )

    jwt_token <- jose::jwt_encode_sig(jwt_claim, private_key, size = 256)
  }

  jwt_token
}


#' Adobe JWT token response
#'
#' Includes the response object containing the bearer token as well as the
#' credentials used to generate the token for seamless refreshing.
#'
#' Refreshing is disabled if the user used a custom JWT token.
#'
#' @section Methods:
#' * `refresh()`: refresh access token (if possible)
#' * `validate()`: TRUE if the token is still valid, FALSE otherwise
#'
#' @docType class
#' @keywords internal
#' @format An R6 object
#' @importFrom R6 R6Class
#' @noRd
AdobeJwtToken <- R6::R6Class("AdobeJwtToken", list(
  secrets = NULL,
  token = NULL,
  initialize = function(token, secrets) {
    self$secrets <- secrets
    self$token <- token
  },
  can_refresh = function() {
    FALSE
  },
  refresh = function() {
    self$token <- auth_jwt_gen(self$secrets)
    self
  },
  validate = function() {
    self$token$date + httr::content(self$token)$expires_in / 1000 > Sys.time() - 1200
  }
))

# S2S ------------------------------------------------------------------

#' @family auth
#' @describeIn cja_auth Authenticate with S2S token
#' @importFrom openssl read_key
#' @export
auth_s2s <- function(file = Sys.getenv("CJA_AUTH_FILE"),
                     s2s_token = NULL,
                     ...) {
  if (file == "") {
    stop("Variable 'CJA_AUTH_FILE' not found but required for default S2S authentication.\nSee `?cja_auth`")
  }

  secrets <- jsonlite::fromJSON(file)

  resp <- auth_s2s_gen(secrets = secrets, s2s_token = s2s_token)

  cja_auth_with('s2s')

  # If successful
  message("Successfully authenticated with S2S: access token valid until ",
          as.POSIXct(resp$expires_at, origin = "1970-01-01"))

  .cjar$token <- AdobeS2SToken$new(resp, secrets)
  .cjar$client_id <- secrets$CLIENT_ID
  .cjar$client_secret <- secrets$CLIENT_SECRETS
  .cjar$org_id <- secrets$ORG_ID
}

#' Generate the authorization response object for S2S
#'
#' @param secrets List of secret values, see `auth_s2s`
#' @param s2s_token Optional, a S2S token (e.g., a cached token)
#'
#' @noRd
auth_s2s_gen <- function(secrets,
                         s2s_token = NULL) {

  stopifnot(is.character(secrets$CLIENT_ID))
  stopifnot(is.character(secrets$CLIENT_SECRETS))
  stopifnot(is.character(secrets$SCOPES))

  if (any(c(secrets$CLIENT_ID, secrets$CLIENT_SECRETS) == "")) {
    stop("Client ID or Client Secret not found.")
  }

  s2s_token <- get_s2s_token(s2s_token = s2s_token,
                             client_id = secrets$CLIENT_ID,
                             scopes = secrets$SCOPES,
                             client_secrets = secrets$CLIENT_SECRETS
                            )

  token <- s2s_token
  token
}



#' Get an encoded, signed S2S token
#'
#' Gets a S2S token
#'
#' @param S2S_token Optional, a S2S token
#' @param client_id Client ID
#' @param secrets Secrets, can be more than one, a vector if more than one or a string if only 1
#' @param scopes Scopes as listed in the project
#'
#' @return A S2S token generated by httr2 oauth_flow_client_credentials
#' @noRd
get_s2s_token <- function(s2s_token = NULL,
                          client_id,
                          client_secrets,
                          scopes = c("openid","AdobeID","additional_info.projectedProductContext","read_pc.acp","read_pc","read_pc.dma_tartan","additional_info","read_organizations","session")
                          ) {
  if (is.null(s2s_token)) {
    s2s_client <- httr2::oauth_client(client_id,
                                      'https://ims-na1.adobelogin.com/ims/token/v3',
                                      secret = paste0(client_secrets, collapse = ','),
                                      auth = 'body')

    s2s_token <- httr2::oauth_flow_client_credentials(client = s2s_client,
                                                      scope = paste0(scopes, collapse = ','),
                                                      token_params = c(grant_type = 'client_credentials',
                                                                       client_id = client_id))

  }

  s2s_token
}


#' Adobe S2S token response
#'
#' Includes the response object containing the bearer token as well as the
#' credentials used to generate the token for seamless refreshing.
#'
#'
#' @section Methods:
#' * `refresh()`: refresh access token (if possible)
#' * `validate()`: TRUE if the token is still valid, FALSE otherwise
#'
#' @docType class
#' @keywords internal
#' @format An R6 object
#' @importFrom R6 R6Class
#' @noRd
AdobeS2SToken <- R6::R6Class("AdobeS2SToken", list(
  secrets = NULL,
  token = NULL,
  initialize = function(token, secrets) {
    self$secrets <- secrets
    self$token <- token
  },
  can_refresh = function() {
    FALSE
  },
  refresh = function() {
    self$token <- auth_s2s_gen(self$secrets)
    self
  },
  validate = function() {
    self$token$expires_at + self$token$expires_at / 1000 > Sys.time() - 1200
  }
))


# OAuth ----------------------------------------------------------------
#' @family auth
#' @describeIn cja_auth Authorize via OAuth 2.0
#' @export
auth_oauth <- function(client_id = Sys.getenv("CJA_CLIENT_ID"),
                       client_secret = Sys.getenv("CJA_CLIENT_SECRET"),
                       use_oob = TRUE) {
  stopifnot(is.character(client_id))
  stopifnot(is.character(client_secret))

  if (use_oob) {
    oob_value <- "https://adobeanalyticsr.com/token_result.html"
  } else {
    oob_value <- NULL
  }


  if (any(c(client_id, client_secret) == "")) {
    stop("Client ID or Client Secret not found. Are your environment variables named `CJA_CLIENT_ID` and `CJA_CLIENT_SECRET`?")
  }

  cja_endpoint <- httr::oauth_endpoint(
    authorize = "authorize/v2/",
    access = "token/v3",
    base_url = "https://ims-na1.adobelogin.com/ims"
  )

  cja_app <- httr::oauth_app(
    appname = "adobe_analytics_v2.0",
    key = client_id,
    secret = client_secret
  )

  #Oauth2 token
  token <- httr::oauth2.0_token(
    endpoint = cja_endpoint,
    app = cja_app,
    scope = "openid,AdobeID,read_organizations,additional_info.projectedProductContext,additional_info.job_function",
    cache = token_path(getOption("cjar.auth_path", "aa.oauth")),
    use_oob = use_oob,
    oob_value = oob_value
  )

  message("Successfully authenticated with OAuth")
  .cjar$token <- token
  .cjar$client_id <- client_id
  .cjar$client_secret <- client_secret
}