#' 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)
}
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.