R/get_token.R

In MatthewJWhittle/getarc: An R Wrapper for the ArcGIS Rest API

#' Get Access Token
#'
#' Get an access token for accessing a service
#'
#' @param use_cache should the token be cached? Currently not working
#' @param auto_refresh should the token automatically be refreshed if it has expired?
#' @param client_id app credential: client ID
#' @param client_secret app credential: client secret
#' @param app_name app credential: app name
#' @param redirect_uri the url to redirect to after authenticating. default is httr::oauth_callback(). This needs to be added into your web app on arc gis for developers.
#' @export get_token
#' @importFrom httr oauth_endpoint
#' @importFrom httr oauth_app
#' @importFrom httr oauth2.0_token
#' @importFrom purrr map_lgl
#' @importFrom rjson fromJSON
get_token <-
  function(client_id = NULL, client_secret = NULL, app_name = NULL,
           use_cache = TRUE, auto_refresh = TRUE,
           redirect_uri = httr::oauth_callback()
           ) {

    credentials <- list(client_id = client_id,
                        client_secret = client_secret,
                        app_name = app_name)

    if(any(purrr::map_lgl(credentials, is.null))){
      # message("Getting credentials from environment variables")
      credentials <- get_credentials()
    }
    endpoint <-
      httr::oauth_endpoint(access = "https://www.arcgis.com/sharing/rest/oauth2/token/",
                     authorize  = "https://www.arcgis.com/sharing/rest/oauth2/authorize/")
    app <-
      httr::oauth_app(appname = credentials$app_name,
                key = credentials$client_id,
                secret = credentials$client_secret,
                # When other people try to run get token they get an eror saying
                # incorrect redirect_uri. I wonder if this is because different users
                # have a different default uri. It is possible to reproduce the error by setting
                # the redirect uri below to one that doesn't match the app set up in arc
                # Doesn't work on RStudio Server
                redirect_uri = redirect_uri)

    # With the request send the datetime which is then automatically stored with the token
    # This is then checked against the expiry seconds and the token is refreshed if neccessary
    # Is the grant_datetime list name an arbitrary choice?
    # Added a new dttm in the query_authorize_extra
    # grant datetime should be updated whenever the token is refreshed
    # access grant datetime will only be updated when the less perishable
    # access token is acquired
    my_token <-
      httr::oauth2.0_token(endpoint = endpoint, app = app, cache = use_cache,
                           query_authorize_extra = list(grant_datetime = Sys.time(),
                                                        access_grant_datetime = Sys.time()
                                                        ))

    # httr doesn't parse the credentials correctly into a list sometimes
    # Think this may be fixed somewhere now so i've added conditional
    # logic to parse it if neccessary
    if(!is.list(my_token$credentials)){
      my_token$credentials <- rjson::fromJSON(my_token$credentials)
    }



    # Check expiry and refresh if neccessary
    # The refresh token is an alteration to httr:::refresh_oauth2.0
    if(auto_refresh & token_expired(my_token)){
      my_token$credentials <-
        refresh_token(
          endpoint = endpoint,
          app = app,
          credentials = my_token$credentials,
          user_params = NULL
        )
      my_token$params$query_authorize_extra$grant_datetime <-
        Sys.time()
    }

    # The refresh token can also expire and needs to be refreshed. This is indicated in an
    # error message. Need to check this then if it is expired:
    # - delete the token from the cache_path
    # - request a new token recursively calling the function
    # - return that token
    refresh_expired <- my_token$credentials$error$message == "refresh_token expired"
    # The message is empty if the token hasn't expired
    # Only check for the message if it there (length > 0)
    if((length(refresh_expired) > 0) && refresh_expired){
      file.remove(my_token$cache_path)
      my_token <- get_token(client_id, client_secret, app_name,
                            use_cache, auto_refresh,
                            redirect_uri)
    }
    return(my_token)
  }
#' Token Expired
#'
#' Has the Oauth token expired
#'
#' @param my_token an access token generated by get_token
#' @return logical value detailing whether the token has or has not expired
#' @importFrom lubridate ymd_hms
#' @importFrom lubridate seconds
#' @importFrom rjson fromJSON
token_expired <-
  function(my_token){
    # Extract the grant time which is passed in when making the request
    grant_dttm <- my_token$params$query_authorize_extra$grant_datetime
    # and the expiry time which is in seconds
    expiry_seconds <- my_token$credentials$expires_in
    # calculate when the token expires and check whether this has occured yet
    expires_at <- lubridate::ymd_hms(grant_dttm) + lubridate::seconds(expiry_seconds)
    # There is something weird going on with timezones so I added the call to
    # ymd_hms, there is probably a better way of doing this to assert that the timezones are equal
    expired <- lubridate::ymd_hms(Sys.time()) > expires_at
    return(expired)
  }
#' Get/Set Credentials
#'
#' Get or set app credentials
#'
#' set_credentials and get_credentials set and retrieve option variables for the client id, client secret and app name.
#' This then allows get_token to retrieve the variables.
#' @param client_id The client ID. Taken from you app dashboard on arcgis for developers
#' @param client_secret The client secret. Taken from you app dashboard on arcgis for developers
#' @param app_name The name of your app. Taken from you app dashboard on arcgis for developers
#' @param path The path where the credentials should be saved
#' @importFrom rjson toJSON
#' @importFrom rjson fromJSON
#' @importFrom jsonlite  write_json
#' @importFrom jsonlite  read_json
#' @export set_credentials
set_credentials <-
  function(client_id,
           client_secret,
           app_name,
           path = "~/secrets/getarc-credentials.json") {

    credentials <-
      list(client_id = client_id,
           client_secret = client_secret,
           app_name = app_name)

    # Check the path exists & create it if not
    if (!dir.exists(dirname(path))) {
      dir.create(dirname(path))
    }
    jsonlite::write_json(rjson::toJSON(credentials), path = path)
  }

get_credentials <-
  function(path  = "~/secrets/getarc-credentials.json") {
    # Check whether the credentials exist and use a path
    if (!file.exists(path)) {
      stop(
        paste0(
          "Credentials not set: \n",
          "Use getarc::set_credentials() to set app credentials for use in get_token. \nVisit https://developers.arcgis.com/dashboard to get your app credentials."
        )
      )
    }
    # Get the credentials from the path and return them in a list
    credentials <- jsonlite::read_json(path)
    rjson::fromJSON(credentials[[1]])
  }

#' Generate a token
#'
#' Generate ArcGIS Access tokens with credentials
#'
#' This functino enables a user to generate a token for accessing
#' ArcGIS services where Oauth2.0 isn't possible. The documentation is here:
#' https://developers.arcgis.com/rest/services-reference/generate-token.htm
#' You should make an effort to protect your username in password so that it isn't saved in the source code.
#' Some good options are here:
#' https://cran.r-project.org/web/packages/httr/vignettes/secrets.html
#'
#' You could write a wrapper function around this function which gets your credentials from an
#' environment variable, calls the function and returns a token. getarc may provide this functionality eventually.
#' @param endpoint the endpoint against which to request the token. this is generally in the format of:
#' `https://{host}:{port}/{site}/tokens/generateToken`
#' e.g: `https://sampleserver6.arcgisonline.com/arcgis/tokens/generateToken`
#' @param  username your ArcGIS online username. You should make an effort to protect this by accessing it from an
#' environment variable so that it isn't saved in your source code or .Rhistory file.
#' @param  password your ArcGIS online password. You should make an effort to protect this by accessing it from an
#' environment variable so that it isn't saved in your source code or .Rhistory file.
#' @param expiration The token expiration time in minutes (defaults to 60)
#' @importFrom httr POST
#' @importFrom httr content
#' @importFrom rjson fromJSON
#' @importFrom httr oauth_callback
#' @export generate_token
generate_token <-
  function(endpoint, username, password, expiration = 60) {
    token <-
      httr::POST(
        url = endpoint,
        encode = "form",
        body = list(
          username = username,
          password = password,
          f = "json",
          client = "referer",
          referer = httr::oauth_callback(),
          expiration = expiration
        )
      )

    rjson::fromJSON(httr::content(token))
  }