R/sdk.R

In kmchugh/com.icatalyst.singularity.r: OAuth 2.0 Authentication against the Singularity API

#' R6 Class representing the Singularity SDK
#'
#' Allows configuration of the interactions between this client and the
#' Singularity Oauth 2.0 server
#' @export
Singularity <- R6::R6Class("Singularity",
  lock_objects = FALSE,


  private = list(
    #' @field the client id generated by the singularity server that represents this client
    client_id = NULL,
    #' @field the client secret generated by the singularity server to allow this client to access the API
    client_secret = NULL,
    #' @field the client key generated by the singularity server to allow this client to access the API
    client_key = NULL,
    #' @field the name of the message handler to create for shiny js code
    message_handler = 'singularity_redirect'
  ),


  active = list(
    #' @description
    #' the custom message handler created to allow redirection from shiny
    shiny_redirect_code = function() {
      paste('Shiny.addCustomMessageHandler(\'',
        private$message_handler,
        '\', function(message) {(window.top || window).location = message;});', sep='')
    }
  ),

  public = list(

    #' @description
    #' Creates a new instance of the SDK
    #' @param client_id the client identifier as generated by Singularity
    #' @param client_secret the client secret as generated by Singularity
    #' @param client_key the client key as generated by Singularity
    #' @param config_file optional configuration file to override the default configuration from
    #' @param config optional config list to override the default configuration with
    initialize = function(client_id, client_secret, client_key, config_file = '.local.config.json', config = NULL) {
      stopifnot(
        is.character(client_id),
        is.character(client_secret),
        is.character(client_key),
        is.character(config_file)
      )

      # Load the default configs then the local overrides
      files <- c(system.file('extdata', 'default.config.json', package='com.icatalyst.singularity', mustWork=TRUE),
        system.file('extdata', '.local.config.json', package='com.icatalyst.singularity'))

      for (file in files[files!=""]) {
        settings <- rjson::fromJSON(file=file)

        # Update the properties from the properties file
        for (name in names(settings)) {
          self[[name]] <- settings[[name]]
        }
      }

      # update from the provided config
      for (name in names(config)) {
        self[[name]] <- config[[name]]
      }

      # update some of the defaults
      private$login_redirect_uri <- self$server_uri
    },

    #' @description
    #' Prints a representation of this object
    #' @param ... print parameters
    print = function(...) {
      cat("Singularity\n")
      cat("  Client ID:", self$client_id, "\n", sep="")
      cat("  Server URL:", self$server_uri, "\n", sep="")
      invisible(self);
    },

    #' @description
    #' Adds a script tag with the redirection handler
    #' This is specifically for shiny
    #' @param tags the shiny tags object
    shiny_tags = function(tags) {
      tags$head(tags$script(self$shiny_redirect_code))
    },

    #' @description
    #' Calls the shiny redirect handler
    #' This is specifically for shiny
    #' @param session the session object from shiny
    #' @param redirect_uri the uri to redirect the user to in
    #'   order to force the trusted login flow
    shiny_redirect = function(session, redirect_uri) {
      session$sendCustomMessage(private$message_handler, redirect_uri)
    }
  )
)