diff --git a/DESCRIPTION b/DESCRIPTION index eca2f2ec..1b16945b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rapbase Type: Package Title: Base Functions and Resources for Rapporteket -Version: 1.23.1 +Version: 1.23.1.9000 Authors@R: c( person(given = "Are", family = "Edvardsen", @@ -53,4 +53,5 @@ Suggests: httptest, lifecycle, rvest, - testthat + testthat, + withr diff --git a/NAMESPACE b/NAMESPACE index c07afb87..e89b7b54 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(autoReportInput) export(autoReportOrgInput) export(autoReportOrgServer) export(autoReportServer) +export(autoReportServer2) export(autoReportUI) export(cleanStagingData) export(createAutoReport) @@ -57,6 +58,7 @@ export(mtimeStagingData) export(navbarWidgetApp) export(navbarWidgetInput) export(navbarWidgetServer) +export(navbarWidgetServer2) export(noOptOutOk) export(orgList2df) export(rapCloseDbConnection) @@ -78,7 +80,9 @@ export(statsGuideUI) export(statsInput) export(statsServer) export(statsUI) +export(unitAttribute) export(upgradeAutoReportData) +export(userAttribute) export(userInfo) export(writeAutoReportData) importFrom(magrittr,"%>%") diff --git a/R/autoReport.R b/R/autoReport.R index 6b95a436..bfca47b7 100644 --- a/R/autoReport.R +++ b/R/autoReport.R @@ -55,7 +55,7 @@ createAutoReport <- function(synopsis, package, type = "subscription", fun, if (is.null(terminateDate)) { context <- Sys.getenv("R_RAP_INSTANCE") terminateDate <- as.POSIXlt(Sys.Date()) - if (context %in% c("PRODUCTION")) { + if (context %in% c("PRODUCTION", "PRODUCTIONC")) { terminateDate$year <- terminateDate$year + 3 } else { terminateDate$mon <- terminateDate$mon + 1 @@ -645,7 +645,7 @@ findNextRunDate <- function(runDayOfYear, #' #' Make a table to be rendered in a shiny app providing automated reports #' from a given user or registry as obtained from the shiny session -#' object provided. +#' object provided or environmental variables when run inside an app container. #' #' Each table record (line) represents a uniquely defined automated report. #' For each line two shiny action buttons are provided to allow @@ -670,26 +670,42 @@ findNextRunDate <- function(runDayOfYear, #' #' @param session A shiny session object #' @param namespace String naming namespace. Defaults to \code{character()} in -#' which case no namespace will be created. When this function is used by shiny -#' modules namespace must be provided. +#' which case no namespace will be created. When this function is used by +#' shiny modules namespace must be provided. +#' @param user Character string providing the username. Introduced as a new +#' argument when running apps inside containers. Default value is set to +#' \code{rapbase::getUserName(session)} to allow backward compatibility. +#' @param group Character string defining the registry, normally corresponding +#' to the R package name and the value stemming from the SHINYPROXY_GROUPS +#' environment variable. Introduced as a new argument when running apps inside +#' containers. Default value is set to \code{rapbase::getUserGroups(session)} +#' to allow backward compatibility. +#' @param orgId Character string or integer defining the organization (id) for +#' \code{user}. Default value is set to \code{rapbase::getUserReshId(session)} +#' to allow backward compatibility. #' @param type Character string defining the type of auto reports to tabulate. -#' Must be one of \code{"subscription"}, \code{"dispatchment"} or -#' \code{"bulletin"}. Default value set to \code{"subscription"}. +#' Must be one of \code{"subscription"}, \code{"dispatchment"} or +#' \code{"bulletin"}. Default value set to \code{"subscription"}. #' @param mapOrgId Data frame containing the two columns 'name' and 'id' -#' corresponding to unique name and id of organizations. Default is NULL in -#' which case the ids provided in auto report data will be used. In case -#' mapOrgId is not NULL but no id match is found the id found in the auto -#' report data will also be used +#' corresponding to unique name and id of organizations. Default is NULL in +#' which case the ids provided in auto report data will be used. In case +#' mapOrgId is not NULL but no id match is found the id found in the auto +#' report data will also be used #' @param includeReportId Logical if the unique report id should be added as -#' the last column in the table. FALSE by default. +#' the last column in the table. FALSE by default. #' #' @return Matrix providing a table to be rendered in a shiny app #' @importFrom magrittr "%>%" #' @export # nolint end -makeAutoReportTab <- function(session, namespace = character(), - type = "subscription", mapOrgId = NULL, +makeAutoReportTab <- function(session, + namespace = character(), + user = rapbase::getUserName(session), + group = rapbase::getUserGroups(session), + orgId = rapbase::getUserReshId(session), + type = "subscription", + mapOrgId = NULL, includeReportId = FALSE) { stopifnot(type %in% c("subscription", "dispatchment", "bulletin")) @@ -697,13 +713,13 @@ makeAutoReportTab <- function(session, namespace = character(), l <- list() autoRep <- readAutoReportData() %>% - filterAutoRep(., by = "package", pass = getUserGroups(session)) %>% + filterAutoRep(., by = "package", pass = group) %>% filterAutoRep(., by = "type", pass = type) if (type == "subscription") { autoRep <- autoRep %>% - filterAutoRep(., by = "owner", pass = getUserName(session)) %>% - filterAutoRep(., by = "organization", pass = getUserReshId(session)) + filterAutoRep(., by = "owner", pass = user) %>% + filterAutoRep(., by = "organization", pass = orgId) } dateFormat <- "%A %e. %B %Y" diff --git a/R/log.R b/R/log.R index 1f06b066..243e4e2d 100644 --- a/R/log.R +++ b/R/log.R @@ -122,9 +122,14 @@ NULL #' try(appLogger(list())) #' } #' -appLogger <- function(session, msg = "No message provided") { +appLogger <- function(session, msg = "No message provided", + .topcall = sys.call(-1), .topenv = parent.frame()) { name <- "appLog" - content <- c(getSessionData(session), list(message = msg)) + parent_environment <- environmentName(topenv(.topenv)) + content <- c( + getSessionData(session, group = parent_environment), + list(message = msg) + ) event <- makeLogRecord(content) appendLog(event, name) } @@ -270,16 +275,19 @@ makeLogRecord <- function(content) { #' Internal function providing session data relevant to logging. #' #' @param session A shiny session object +#' @param group Character string providing the name of the app R package name. +#' The term "group" is used to relate to the environmental variable +#' SHINYPROXY_USERGROUPS that corresponds to the apps a given user can access. #' #' @return A list of relevant log fields #' @keywords internal -getSessionData <- function(session) { +getSessionData <- function(session, group = NULL) { list( - user = rapbase::getUserName(session), - name = rapbase::getUserFullName(session), - group = rapbase::getUserGroups(session), - role = rapbase::getUserRole(session), - resh_id = rapbase::getUserReshId(session) + user = rapbase::getUserName(session, group), + name = rapbase::getUserFullName(session, group), + group = rapbase::getUserGroups(session, group), + role = rapbase::getUserRole(session, group), + resh_id = rapbase::getUserReshId(session, group) ) } diff --git a/R/misc.R b/R/misc.R index 21f1e0e0..b6bbd16a 100644 --- a/R/misc.R +++ b/R/misc.R @@ -61,7 +61,8 @@ getRapPackages <- function() { #' isRapContext() #' isRapContext <- function() { - if (Sys.getenv("R_RAP_INSTANCE") %in% c("DEV", "TEST", "QA", "PRODUCTION")) { + if (Sys.getenv("R_RAP_INSTANCE") %in% + c("DEV", "TEST", "QA", "PRODUCTION", "PRODUCTIONC")) { return(TRUE) } else { return(FALSE) diff --git a/R/moduleAutoReport.R b/R/moduleAutoReport.R index 452deca4..3fe1e0e3 100644 --- a/R/moduleAutoReport.R +++ b/R/moduleAutoReport.R @@ -19,48 +19,50 @@ #' schedule and must therefore represent existing and exported functions from #' the registry R package. For subscriptions the \emph{reports} list can be used #' as is, more specifically that the values provided in \emph{paramValues} can -#' go unchanged. For dispatchments and bulletins it is likely that parameter -#' values must be set dynamically in which case \emph{paramValues} must be -#' a reactive part of the application. See Examples on how function arguments -#' may be used as reactives in an application. +#' go unchanged. It is likely that parameter values must be set dynamically at +#' runtime in which case \emph{paramValues} must be a reactive part of the +#' application. See Examples on how function arguments may be used as reactives +#' in an application. #' #' @param id Character string providing the shiny module id. #' @param registryName Character string with the registry name key. Must -#' correspond to the registry R package name. +#' correspond to the registry R package name. #' @param type Character string defining the type of auto reports. Must be one -#' of \code{c("subscription", "dispatchment", "bulletin")} +#' of \code{c("subscription", "dispatchment", "bulletin")} #' @param reports List of a given structure that provides meta data for the -#' reports that are made available as automated reports. See Details for further -#' description. +#' reports that are made available as automated reports. See Details for +#' further description. #' @param org Shiny reactive or NULL (default) defining the organization (id) -#' of the data source used for dispatchments and bulletins (in which case it -#' cannot be set to NULL) and its value will be used to populate the -#' \emph{organization} field in auto report data (autoReport.yml) for these auto -#' report types. On the other hand, since subscriptions are personal (per user) -#' the only relevant organization id will implicit be that of the user and in -#' this case any value of \code{org} will be disregarded. +#' of the data source used for dispatchments and bulletins (in which case it +#' cannot be set to NULL) and its value will be used to populate the +#' \emph{organization} field in auto report data (autoReport.yml) for these +#' auto report types. On the other hand, since subscriptions are personal +#' (per user) the only relevant organization id will implicit be that of the +#' user and in this case any value of \code{org} will be disregarded. #' @param paramNames Shiny reactive value as a vector of parameter names of -#' which values are to be set interactively at application run time. Each -#' element of this vector must match exactly those of \code{paramValues}. -#' Default value is \code{shiny::reactiveVal("")}. +#' which values are to be set interactively at application run time. Each +#' element of this vector must match exactly those of \code{paramValues}. +#' Default value is \code{shiny::reactiveVal("")}. #' @param paramValues Shiny reactive value as a vector of those parameter values -#' to be set interactively, \emph{i.e.} as per user input in the application. -#' Default value is set to \code{shiny::reactiveVal("")} in which case parameter -#' values defined in \code{reports} will be used as is. In other words, -#' explicit use of \code{paramValues} will only be needed if parameter values -#' must be changed during application run time. If so, each element of this -#' vector must correspond exactly to those of \code{paramNames}. +#' to be set interactively, \emph{i.e.} as per user input in the application. +#' Default value is set to \code{shiny::reactiveVal("")} in which case +#' parameter values defined in \code{reports} will be used as is. In other +#' words, explicit use of \code{paramValues} will only be needed if parameter +#' values must be changed during application run time. If so, each element of +#' this vector must correspond exactly to those of \code{paramNames}. #' @param orgs Named list of organizations (names) and ids (values). When set to -#' \code{NULL} (default) the ids found in auto report data will be used in the -#' table listing existing auto reports. +#' \code{NULL} (default) the ids found in auto report data will be used in the +#' table listing existing auto reports. #' @param eligible Logical defining if the module should be allowed to work at -#' full capacity. This might be useful when access to module products should be -#' restricted. Default is TRUE, \emph{i.e.} no restrictions. +#' full capacity. This might be useful when access to module products should +#' be restricted. Default is TRUE, \emph{i.e.} no restrictions. #' @param freq Character string defining default frequency set in the auto -#' report GUI. Must be one of -#' \code{c("day", "week", "month", "quarter", "year")}. Default value is -#' "month". -#' +#' report GUI. Must be one of +#' \code{c("day", "week", "month", "quarter", "year")}. Default value is +#' "month". +#' @param user List of shiny reactive values providing user metadata and +#' privileges corresponding to the return value of +#' \code{\link{navbarWidgetServer}}. #' #' @return In general, shiny objects. In particular, \code{autoreportOrgServer} #' returns a list with names "name" and "value" with corresponding reactive @@ -70,8 +72,8 @@ #' "id". #' @name autoReport #' @aliases autoReportUI autoReportOrgInput autoReportOrgServer -#' autoReportFormatInput autoReportFormatSercer autoReportInput autoReportServer -#' autoReportApp orgList2df +#' autoReportFormatInput autoReportFormatSercer autoReportInput +#' autoReportServer autoReportApp orgList2df #' @examples #' ## make a list for report metadata #' reports <- list( @@ -235,11 +237,11 @@ autoReportServer <- function(id, registryName, type, org = NULL, stopifnot(freq %in% c("day", "week", "month", "quarter", "year")) defaultFreq <- switch(freq, - day = "Daglig-day", - week = "Ukentlig-week", - month = "M\u00E5nedlig-month", - quarter = "Kvartalsvis-quarter", - year = "\u00C5rlig-year" + day = "Daglig-day", + week = "Ukentlig-week", + month = "M\u00E5nedlig-month", + quarter = "Kvartalsvis-quarter", + year = "\u00C5rlig-year" ) shiny::moduleServer(id, function(input, output, session) { @@ -400,6 +402,377 @@ autoReportServer <- function(id, registryName, type, org = NULL, ) }) + output$start <- shiny::renderUI({ + shiny::req(input$freq) + shiny::dateInput( + shiny::NS(id, "start"), + label = shiny::tags$div( + shiny::HTML( + as.character(shiny::icon("calendar")), "F\u00F8rste utsending:" + ) + ), + # if freq is year make first issue tomorrow, otherwise postpone by freq + value = if (strsplit(input$freq, "-")[[1]][2] == "year") { + Sys.Date() + 1 + } else { + seq.Date(Sys.Date(), + by = strsplit(input$freq, "-")[[1]][2], + length.out = 2 + )[2] + }, + min = Sys.Date() + 1, + max = seq.Date(Sys.Date(), length.out = 2, by = "1 years")[2] - 1 + ) + }) + + output$email <- shiny::renderUI({ + if (type %in% c("dispatchment", "bulletin")) { + shiny::textInput( + shiny::NS(id, "email"), + label = shiny::tags$div( + shiny::HTML(as.character(shiny::icon("at")), "E-post mottaker:") + ), + value = "gyldig@epostadresse.no" + ) + } else { + NULL + } + }) + + output$editEmail <- shiny::renderUI({ + if (type %in% c("dispatchment", "bulletin")) { + shiny::req(input$email) + if (!grepl( + "^[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\\.[A-Za-z]{2,}$", + input$email + )) { + NULL + } else { + if (input$email %in% autoReport$email) { + shiny::actionButton( + shiny::NS(id, "delEmail"), + shiny::HTML(paste("Slett mottaker
", input$email)), + icon = shiny::icon("minus-square") + ) + } else { + shiny::actionButton( + shiny::NS(id, "addEmail"), + shiny::HTML(paste("Legg til mottaker
", input$email)), + icon = shiny::icon("plus-square") + ) + } + } + } else { + NULL + } + }) + + output$recipient <- shiny::renderUI({ + if (type %in% c("dispatchment", "bulletin")) { + recipientList <- paste0(autoReport$email, sep = "
", collapse = "") + shiny::HTML(paste0("Mottakere:
", recipientList)) + } else { + NULL + } + }) + + output$makeAutoReport <- shiny::renderUI({ + if (is.null(autoReport$report) || !eligible) { + NULL + } else { + if (type %in% c("subscription")) { + shiny::actionButton( + shiny::NS(id, "makeAutoReport"), + "Lag oppf\u00F8ring", + icon = shiny::icon("save") + ) + } else { + shiny::req(input$email) + if (length(autoReport$email) == 0) { + NULL + } else { + shiny::actionButton( + shiny::NS(id, "makeAutoReport"), + "Lag oppf\u00F8ring", + icon = shiny::icon("save") + ) + } + } + } + }) + + output$activeReports <- DT::renderDataTable( + autoReport$tab, + server = FALSE, escape = FALSE, selection = "none", + rownames = FALSE, + options = list( + dom = "tp", ordering = FALSE, + language = list( + lengthMenu = "Vis _MENU_ rader per side", + search = "S\u00f8k:", + info = "Rad _START_ til _END_ av totalt _TOTAL_", + paginate = list(previous = "Forrige", `next` = "Neste") + ) + ) + ) + + output$autoReportTable <- shiny::renderUI({ + if (!eligible) { + shiny::tagList( + shiny::h2(paste0("Funksjonen ('", type, "') er utilgjengelig")), + shiny::p("Ved sp\u00F8rsm\u00E5l ta gjerne kontakt med registeret."), + shiny::hr() + ) + } else if (length(autoReport$tab) == 0) { + shiny::tagList( + shiny::h2("Det finnes ingen oppf\u00F8ringer"), + shiny::p(paste( + "Nye oppf\u00F8ringer kan lages fra menyen til", + "venstre. Bruk gjerne veiledingen under." + )), + shiny::htmlOutput(shiny::NS(id, "autoReportGuide")) + ) + } else { + shiny::tagList( + shiny::h2("Aktive oppf\u00F8ringer:"), + DT::dataTableOutput(shiny::NS(id, "activeReports")), + shiny::htmlOutput(shiny::NS(id, "autoReportGuide")) + ) + } + }) + + output$autoReportGuide <- shiny::renderUI({ + renderRmd( + sourceFile = system.file("autoReportGuide.Rmd", package = "rapbase"), + outputType = "html_fragment", + params = list(registryName = registryName, type = type) + ) + }) + }) +} + + +#' @rdname autoReport +#' @export +autoReportServer2 <- function( + id, + registryName, + type, + org = NULL, + paramNames = shiny::reactiveVal(c("")), + paramValues = shiny::reactiveVal(c("")), + reports = NULL, + orgs = NULL, + eligible = TRUE, + freq = "month", + user +) { + stopifnot( + all(unlist(lapply(user, shiny::is.reactive), use.names = FALSE)) + ) + if (!type %in% c("subscription")) { + stopifnot(shiny::is.reactive(org)) + stopifnot(shiny::is.reactive(paramNames)) + stopifnot(shiny::is.reactive(paramValues)) + } + stopifnot(freq %in% c("day", "week", "month", "quarter", "year")) + + defaultFreq <- switch(freq, + day = "Daglig-day", + week = "Ukentlig-week", + month = "M\u00E5nedlig-month", + quarter = "Kvartalsvis-quarter", + year = "\u00C5rlig-year" + ) + + shiny::moduleServer(id, function(input, output, session) { + autoReport <- shiny::reactiveValues( + tab = makeAutoReportTab( + session = session, + namespace = id, + user = NULL, + group = registryName, + orgId = NULL, + type = type, + mapOrgId = orgList2df(orgs) + ), + report = names(reports)[1], + org = unlist(orgs, use.names = FALSE)[1], + freq = defaultFreq, + email = vector() + ) + + ## update tab whenever changes to user privileges (and on init) + userEvent <- shiny::reactive( + list(user$name(), user$org(), user$role()) + ) + shiny::observeEvent( + userEvent(), + autoReport$tab <- makeAutoReportTab( + session = session, + namespace = id, + user = user$name(), + group = registryName, + orgId = user$org(), + type = type, + mapOrgId = orgList2df(orgs) + ), + ignoreNULL = FALSE + ) + + shiny::observeEvent(input$addEmail, { + autoReport$email <- c(autoReport$email, input$email) + }) + + shiny::observeEvent(input$delEmail, { + autoReport$email <- autoReport$email[!autoReport$email == input$email] + }) + + shiny::observeEvent(input$makeAutoReport, { + report <- reports[[input$report]] + interval <- strsplit(input$freq, "-")[[1]][2] + paramValues <- report$paramValues + paramNames <- report$paramNames + + if (type %in% c("subscription") || is.null(orgs)) { + email <- user$email() + organization <- user$org() + } else { + organization <- org() + email <- autoReport$email + } + if (!paramValues()[1] == "") { + stopifnot(length(paramNames()) == length(paramValues())) + for (i in seq_len(length(paramNames()))) { + paramValues[paramNames == paramNames()[i]] <- paramValues()[i] + } + } + + createAutoReport( + synopsis = report$synopsis, + package = registryName, + type = type, + fun = report$fun, + paramNames = report$paramNames, + paramValues = paramValues, + owner = user$name(), + ownerName = user$fullName(), + email = email, + organization = organization, + runDayOfYear = makeRunDayOfYearSequence( + interval = interval, + startDay = input$start + ), + startDate = input$start, + interval = interval, + intervalName = strsplit(input$freq, "-")[[1]][1] + ) + autoReport$tab <- + makeAutoReportTab( + session, + namespace = id, + user = user$name(), + group = registryName, + orgId = user$org(), + type = type, + mapOrgId = orgList2df(orgs) + ) + autoReport$email <- vector() + }) + + shiny::observeEvent(input$edit_button, { + repId <- strsplit(input$edit_button, "__")[[1]][2] + rep <- readAutoReportData()[[repId]] + + # try matching report by synopsis, fallback to currently selected + for (i in names(reports)) { + if (reports[[i]]$synopsis == rep$synopsis) { + autoReport$report <- i + } + } + autoReport$org <- rep$organization + autoReport$freq <- paste0(rep$intervalName, "-", rep$interval) + autoReport$email <- rep$email + deleteAutoReport(repId) + autoReport$tab <- makeAutoReportTab( + session, + namespace = id, + user = user$name(), + group = registryName, + orgId = user$org(), + type = type, + mapOrgId = orgList2df(orgs) + ) + + if (rep$type == "subscription") { + + } + if (rep$type == "dispatchment") { + + } + if (rep$type == "bulletin") { + + } + }) + + shiny::observeEvent(input$del_button, { + repId <- strsplit(input$del_button, "__")[[1]][2] + deleteAutoReport(repId) + autoReport$tab <- makeAutoReportTab( + session, + namespace = id, + user = user$name(), + group = registryName, + orgId = user$org(), + type = type, + mapOrgId = orgList2df(orgs) + ) + }) + + # outputs + output$reports <- shiny::renderUI({ + if (is.null(reports)) { + NULL + } else { + shiny::selectInput( + shiny::NS(id, "report"), + label = shiny::tags$div( + shiny::HTML(as.character(shiny::icon("file")), "Velg rapport:") + ), + choices = names(reports), + selected = autoReport$report + ) + } + }) + + output$synopsis <- shiny::renderUI({ + shiny::req(input$report) + shiny::HTML( + paste0( + "Rapportbeskrivelse:
", + reports[[input$report]]$synopsis, + "" + ) + ) + }) + + output$freq <- shiny::renderUI({ + shiny::selectInput( + shiny::NS(id, "freq"), + label = shiny::tags$div( + shiny::HTML(as.character(shiny::icon("clock")), "Frekvens:") + ), + choices = list( + "Aarlig" = "\u00C5rlig-year", + "Kvartalsvis" = "Kvartalsvis-quarter", + "Maanedlig" = "M\u00E5nedlig-month", + "Ukentlig" = "Ukentlig-week", + "Daglig" = "Daglig-day" + ), + selected = autoReport$freq + ) + }) + output$start <- shiny::renderUI({ shiny::req(input$freq) shiny::dateInput( diff --git a/R/moduleNavbarWidget.R b/R/moduleNavbarWidget.R index 85505b1b..abc7cc8d 100644 --- a/R/moduleNavbarWidget.R +++ b/R/moduleNavbarWidget.R @@ -10,18 +10,23 @@ #' #' @param id Character string providing module namespace #' @param addUserInfo Logical defining if an "about" hyperlink is to be added +#' @param selectOrganization Logical providing option for selecting among +#' available organizations and roles. #' @param orgName Character string naming the organization #' @param caller Character string naming the environment this function was -#' called from. Default value is \code{environmentName(rlang::caller_env())}. -#' The value is used to display the current version of the R package -#' representing the registry at Rapporteket. If this module is called from -#' exported functions in the registry R package use the default value. If the -#' module is called from outside the registry environment \code{caller} must be -#' set to the actual name of the R package. -#' -#' @return Shiny objects, mostly. Helper functions may return other stuff too. +#' called from. Default value is +#' \code{environmentName(topenv(parent.frame()))}. The value is used to +#' display the current version of the R package representing the registry at +#' Rapporteket. If this module is called from exported functions in the +#' registry R package the default value should be applied. If the module is +#' called from outside the registry environment \code{caller} must be set to +#' the actual name of the R package. +#' +#' @return Shiny objects, mostly. \code{navbarWidgetServer()} invisibly returns +#' a list of reactive values representing user metadata and privileges. See +#' \code{\link{userAttribute}} for further details on these values. #' @name navbarWidget -#' @aliases navbarWidgetInput navbarWidgetServer navbarWidgetApp +#' @aliases navbarWidgetInput navbarWidgetServer2 navbarWidgetApp #' @examples #' ## client user interface function #' ui <- shiny::tagList( @@ -50,7 +55,9 @@ NULL #' @rdname navbarWidget #' @export -navbarWidgetInput <- function(id, addUserInfo = TRUE) { +navbarWidgetInput <- function(id, + addUserInfo = TRUE, + selectOrganization = FALSE) { shiny::addResourcePath("rap", system.file("www", package = "rapbase")) shiny::tagList( @@ -58,6 +65,7 @@ navbarWidgetInput <- function(id, addUserInfo = TRUE) { user = shiny::uiOutput(shiny::NS(id, "name")), organization = shiny::uiOutput(shiny::NS(id, "affiliation")), addUserInfo = addUserInfo, + selectOrganization = selectOrganization, namespace = id ), shiny::tags$head( @@ -92,6 +100,112 @@ navbarWidgetServer <- function(id, orgName, }) } + +#' @rdname navbarWidget +#' @export +navbarWidgetServer2 <- function( + id, + orgName, + caller = environmentName(topenv(parent.frame())) +) { + + shiny::moduleServer(id, function(input, output, session) { + + user <- userAttribute(caller) + stopifnot(length(user$name) > 0) + + # Initial privileges and affiliation will be first in list + rv <- shiny::reactiveValues( + name = user$name[1], + fullName = user$fullName[1], + phone = user$phone[1], + email = user$email[1], + group = user$group[1], + unit = user$unit[1], + org = user$org[1], + role = user$role[1], + orgName = user$orgName[1] + ) + + output$name <- shiny::renderText(rv$fullName) + output$affiliation <- shiny::renderText(paste(orgName, rv$role, sep = ", ")) + + # User info in widget + userInfo <- howWeDealWithPersonalData(session, callerPkg = caller) + shiny::observeEvent(input$userInfo, { + shinyalert::shinyalert( + "Dette vet Rapporteket om deg:", + userInfo, + type = "", imageUrl = "rap/logo.svg", + closeOnEsc = TRUE, + closeOnClickOutside = TRUE, + html = TRUE, + confirmButtonText = rapbase::noOptOutOk() + ) + }) + + # Select organization in widget (for container apps only) + shiny::observeEvent(input$selectOrganization, { + choices <- user$unit + names(choices) <- paste0( + user$orgName, " (", user$org, ") - ", user$role + ) + + shinyalert::shinyalert( + html = TRUE, + title = "Velg organisasjon og rolle", + text = shiny::tagList(shiny::tagList( + shiny::p( + paste( + "Velg organisasjon og rolle du \u00f8nsker \u00e5 representere", + "for", orgName, "i Rapporteket og trykk OK.", + "Dine valgmuligheter er basert p\u00e5 de tilganger som er satt.", + "Ta kontakt med registeret om du mener at lista over valg", + "ikke er riktg." + ) + ), + shiny::selectInput( + session$ns("unit"), + "", + choices, + selected = rv$unit + ) + )), + type = "", imageUrl = "rap/logo.svg", + closeOnEsc = FALSE, + closeOnClickOutside = FALSE, + confirmButtonText = "OK" + ) + }) + + shiny::observeEvent(input$unit, { + rv$name <- user$name[user$unit == input$unit] + rv$fullName <- user$fullName[user$unit == input$unit] + rv$phone <- user$phone[user$unit == input$unit] + rv$email <- user$email[user$unit == input$unit] + rv$group <- user$group[user$unit == input$unit] + rv$unit <- user$unit[user$unit == input$unit] + rv$org <- user$org[user$unit == input$unit] + rv$role <- user$role[user$unit == input$unit] + rv$orgName <- user$orgName[user$unit == input$unit] + }) + + invisible( + list( + name = shiny::reactive(rv$name), + fullName = shiny::reactive(rv$fullName), + phone = shiny::reactive(rv$phone), + email = shiny::reactive(rv$email), + group = shiny::reactive(rv$group), + unit = shiny::reactive(rv$unit), + org = shiny::reactive(rv$org), + role = shiny::reactive(rv$role), + orgName = shiny::reactive(rv$orgName) + ) + ) + }) +} + #' @rdname navbarWidget #' @export navbarWidgetApp <- function(orgName = "Org Name") { @@ -101,7 +215,11 @@ navbarWidgetApp <- function(orgName = "Org Name") { shiny::tabPanel( "Testpanel", shiny::mainPanel( - navbarWidgetInput("testWidget") + navbarWidgetInput( + "testWidget", + addUserInfo = TRUE, + selectOrganization = FALSE + ) ) ) ) @@ -151,9 +269,10 @@ navbarWidgetApp <- function(orgName = "Org Name") { #' @param user String providing the name of the user #' @param organization String providing the organization of the user #' @param addUserInfo Logical defining whether a user data pop-up is to be part -#' of the widget (TRUE) or not (FALSE, default) +#' of the widget (TRUE) or not (FALSE, default) +#' @param selectOrganization Logical if organization can be selected. #' @param namespace Character string providing the namespace to use, if any. -#' Defaults is \code{NULL} in which case no namespace will be applied. +#' Defaults is \code{NULL} in which case no namespace will be applied. #' #' @return Ready made html script #' @export @@ -163,7 +282,9 @@ navbarWidgetApp <- function(orgName = "Org Name") { appNavbarUserWidget <- function(user = "Undefined person", organization = "Undefined organization", addUserInfo = FALSE, + selectOrganization = FALSE, namespace = NULL) { + if (addUserInfo) { userInfo <- shiny::tags$a( id = shiny::NS(namespace, "userInfo"), @@ -175,6 +296,17 @@ appNavbarUserWidget <- function(user = "Undefined person", userInfo <- character() } + if (selectOrganization) { + org <- shiny::tags$a( + id = shiny::NS(namespace, "selectOrganization"), + href = "#", + class = "action-button", + shiny::HTML(gsub("\\n", "", organization)) + ) + } else { + org <- organization + } + txtWidget <- paste0( "var header = $('.navbar> .container-fluid');\n", @@ -182,7 +314,7 @@ appNavbarUserWidget <- function(user = "Undefined person", "style=\"float:right;vertical-align:super;font-size:65%\">", userInfo, user, - organization, + org, "');\n", "console.log(header)" ) diff --git a/R/userAttribute.R b/R/userAttribute.R index 47c2e08f..12cd91e6 100644 --- a/R/userAttribute.R +++ b/R/userAttribute.R @@ -1,48 +1,71 @@ #' Provide user attributes based on environment context #' -#' Extracts elements from either config, url (shiny) or session (shiny) -#' relevant for user data such as name, group, role and reshId. Source of info -#' is based on environment context and can be controlled by altering the default -#' settings for which contexts that will apply for the various sources of user -#' data. This function will normally be used via its helper functions (see -#' below). +#' Extracts elements from either config, url (shiny), shiny session or +#' environmental variables relevant for user data such as name, group, role and +#' org id (\emph{e.g.} resh id). Source of info is based on environment context +#' and can be controlled by altering the default settings for which contexts +#' that will apply for the various sources of user data. This function will +#' normally be used via its helper functions (see below). #' #' @param entity String defining the element to return. Currently, one of -#' 'user', groups', 'resh_id', 'role', 'email', 'full_name' or 'phone' +#' 'user', groups', 'resh_id', 'role', 'email', 'full_name' or 'phone'. #' @param shinySession Shiny session object (list, NULL by default). Must be -#' provided when the source of user attributes is either the shiny app url or -#' an external authentication provider. By default this will apply to the -#' 'TEST', 'QA' and 'PRODUCTION' contexts in which case the shiny session -#' object must be provided. +#' provided when the source of user attributes is either the shiny app url or +#' an external authentication provider. By default this will apply to the +#' 'TEST', 'QA' and 'PRODUCTION' contexts in which case the shiny session +#' object must be provided. #' @param devContexts A character vector providing unique instances to be -#' regarded as a development context. In this context user attributes will be -#' read from configuration as provided by 'rapbaseConfig.yml'. The instances -#' provided cannot overlap instances provided in any other contexts. By default -#' set to \code{c("DEV")}. +#' regarded as a development context. In this context user attributes will be +#' read from configuration as provided by 'rapbaseConfig.yml'. The instances +#' provided cannot overlap instances provided in any other contexts. By +#' default set to \code{c("DEV")}. #' @param testContexts A character vector providing unique instances to be -#' regarded as a test context. In this context user attributes will be read -#' from the url call to a shiny application. Hence, for this context the -#' corresponding shiny session object must also be provided. The instances -#' provided cannot overlap instances provided in any other contexts. By default -#' set to \code{c("TEST")}. +#' regarded as a test context. In this context user attributes will be read +#' from the url call to a shiny application. Hence, for this context the +#' corresponding shiny session object must also be provided. The instances +#' provided cannot overlap instances provided in any other contexts. By +#' default set to \code{c("TEST")}. #' @param prodContexts A character vector providing unique instances to be -#' regarded as a production context. In this context user attributes will be -#' read from the shiny session object (as shiny server interacts with an -#' external log-in service). Hence, for this context the corresponding shiny -#' session object must also be provided. The instances provided cannot overlap -#' instances provided in any other contexts. By default set to -#' \code{c("QA", "PRODUCTION")}. +#' regarded as a production context. In this context user attributes will be +#' read from the shiny session object (on deployment in shiny-server) or, from +#' environmental variables (on standalone container deployment). Hence, for +#' this context the corresponding shiny session object must also be provided. +#' Instances provided cannot overlap instances in any other contexts. By +#' default set to \code{c("QA", "QAC", "PRODUCTION", "PRODUCTIONC")}. +#' Duplication as seen by the "C" suffix will be needed as long as apps in +#' question are to be run on both shiny-server and as standalone containers. +#' @param group Character string providing the name of the app R package name. +#' The term "group" is used to relate to the environmental variable +#' SHINYPROXY_USERGROUPS that corresponds to the apps a given user can access. #' #' @return String of single user data element #' #' @seealso \code{\link{getUserName}}, \code{\link{getUserGroups}}, -#' \code{\link{getUserReshId}}, \code{\link{getUserRole}} +#' \code{\link{getUserReshId}}, \code{\link{getUserRole}} #' #' @export -userInfo <- function(entity, shinySession = NULL, devContexts = c("DEV"), - testContexts = c("TEST"), - prodContexts = c("QA", "PRODUCTION")) { +userInfo <- function( + entity, + shinySession = NULL, + devContexts = c("DEV"), + testContexts = c("TEST"), + prodContexts = c("QA", "QAC", "PRODUCTION", "PRODUCTIONC"), + group = NULL +) { + + # stop helper function + stopifnotShinySession <- function(object) { + if (!inherits( + shinySession, c("ShinySession", "session_proxy", "MockShinySession") + )) { + stop(paste( + "'ShinySession' argument is not a shiny session object! Cannot go on." + )) + } else { + invisible() + } + } # check for valid entities if (!(entity %in% c( @@ -50,7 +73,7 @@ userInfo <- function(entity, shinySession = NULL, devContexts = c("DEV"), "full_name", "phone" ))) { stop("Incorrect entity provided! Must be one of 'user', 'groups', 'resh_id' - 'role' or 'email'") + 'role', 'email', 'full_name' or 'phone'.") } # check if any contexts overlap, and stop if so @@ -76,17 +99,8 @@ userInfo <- function(entity, shinySession = NULL, devContexts = c("DEV"), } if (context %in% devContexts) { - if (is.null(shinySession)) { - stop("Session information is empty! Eventually, that will come bite you") - } - if (!any(c("ShinySession", "session_proxy", "MockShinySession") %in% - attributes(shinySession)$class)) { - stop(paste( - "Got no object of class 'ShinySession' or 'session_proxy'!", - "Your carma is way below threshold..." - )) - } + stopifnotShinySession(shinySession) conf <- getConfig(fileName = "rapbaseConfig.yml") d <- conf$r$testUser @@ -99,31 +113,25 @@ userInfo <- function(entity, shinySession = NULL, devContexts = c("DEV"), phone <- d$phone } - if (context %in% testContexts || context %in% prodContexts) { - if (is.null(shinySession)) { - stop("Session information is empty!. Cannot do anything") - } + if (context %in% testContexts) { - if (!any(c("ShinySession", "session_proxy") %in% - attributes(shinySession)$class)) { - stop(paste( - "Got no object of class 'ShinySession' or 'session_proxy'!", - "Cannot do anything" - )) - } + stopifnotShinySession(shinySession) - if (context %in% testContexts) { - us <- shiny::parseQueryString(shinySession$clientData$url_search) - user <- us$`X-USER` - groups <- us$`X-GROUPS` - resh_id <- us$resh_id - role <- us$role - email <- us$email - full_name <- us$full_name - phone <- us$phone - } + us <- shiny::parseQueryString(shinySession$clientData$url_search) + user <- us$`X-USER` + groups <- us$`X-GROUPS` + resh_id <- us$resh_id + role <- us$role + email <- us$email + full_name <- us$full_name + phone <- us$phone + } - if (context %in% prodContexts) { + if (context %in% prodContexts) { + + stopifnotShinySession(shinySession) + + if (context %in% c("QA", "PRODUCTION")) { user <- shinySession$user groups <- shinySession$groups resh_id <- shinySession$request$HTTP_RESHID @@ -133,6 +141,19 @@ userInfo <- function(entity, shinySession = NULL, devContexts = c("DEV"), parse(text = paste0("'", shinySession$request$HTTP_FULLNAME, "'"))[[1]] phone <- shinySession$request$HTTP_PHONE } + + if (context %in% c("QAC", "PRODUCTIONC")) { + userprivs <- userAttribute(group) + # pick the first of available user privileges + userprivs <- as.data.frame(userprivs, stringsAsFactors = FALSE)[1, ] + user <- userprivs$name + groups <- userprivs$group + resh_id <- userprivs$org + role <- userprivs$role + email <- userprivs$email + full_name <- userprivs$fullName + phone <- userprivs$phone + } } switch(entity, @@ -147,200 +168,239 @@ userInfo <- function(entity, shinySession = NULL, devContexts = c("DEV"), } -#' Get user email from config or session object -#' -#' This is a helper function for \code{\link{userInfo}}. When used without a -#' shiny session object calls to this function is made without any arguments. If -#' redefining contexts is needed, please use \code{\link{userInfo}} instead. -#' -#' @inheritParams userInfo -#' -#' @return String email address -#' -#' @seealso \code{\link{getUserName}}, -#' \code{\link{getUserGroups}}, \code{\link{getUserReshId}}, -#' \code{\link{getUserEmail}} -#' -#' @examples -#' \donttest{ -#' # Requires a valid shiny session object -#' try(getUserEmail()) -#' try(getUserEmail(shinySessionObject)) -#' } -#' +#' User attributes in container apps running behind shinyproxy +#' +#' For apps running as containers particular environment variables must be +#' defined for an orderly handling of dynamic user privileges. This function +#' makes use of environmental variables defined by shinyproxy to provide +#' available privileges for the shiny application. +#' +#' @param group Character string providing the name of the app R package name. +#' The term "group" is used to relate to the environmental variable +#' SHINYPROXY_USERGROUPS that corresponds to the apps a given user can access. +#' @param unit Integer providing the look-up unit id. Default value is NULL in +#' which case all privileges for \code{group} are returned. +#' +#' @return Invisibly a list of user metadata and privileges: +#' \describe{ +#' \item{name}{The username for whom the privileges apply.} +#' \item{fullName}{User full name} +#' \item{phone}{User phone number} +#' \item{email}{User email} +#' \item{group}{Group of which the user is a member.} +#' \item{unit}{Unit id under which the privileges are defined.} +#' \item{org}{Organization id for the user.} +#' \item{role}{Role of the user.} +#' \item{orgName}{Name of the organization as defined under the unit id.} +#' } #' @export +userAttribute <- function(group, unit = NULL) { -getUserEmail <- function(shinySession = NULL) { - userInfo(shinySession, entity = "email") -} + stopifnot(group %in% utils::installed.packages()[, 1]) + if (Sys.getenv("SHINYPROXY_USERGROUPS") == "" || + Sys.getenv("USERORGID") == "") { + stop(paste( + "Environmental variables SHINYPROXY_USERGROUPS and USERORGID must both", + "be set!" + )) + } -#' Get user full name from config or session object -#' -#' This is a helper function for \code{\link{userInfo}}. When used without a -#' shiny session object calls to this function is made without any arguments. If -#' redefining contexts is needed, please use \code{\link{userInfo}} instead. -#' -#' @inheritParams userInfo -#' -#' @return String full name -#' -#' @seealso \code{\link{getUserName}}, -#' \code{\link{getUserGroups}}, \code{\link{getUserReshId}}, -#' \code{\link{getUserEmail}}, \code{\link{getUserPhone}} -#' -#' @examples -#' \donttest{ -#' # Requires a valid shiny session object -#' try(getUserFullName()) -#' try(getUserFullName(shinySessionObject)) -#' } -#' -#' @export + name <- Sys.getenv("SHINYPROXY_USERNAME") + fullName <- parse(text = paste0("'", Sys.getenv("USERFULLNAME"), "'"))[[1]] + phone <- Sys.getenv("USERPHONE") + email <- Sys.getenv("USEREMAIL") + + # make vectors of vals + units <- unlist( + strsplit( + gsub("\\s|\\[|\\]", "", Sys.getenv("USERORGID")), + "," + ) + ) + groups <- unlist( + strsplit( + gsub("\\s|\\[|\\]", "", Sys.getenv("SHINYPROXY_USERGROUPS")), + "," + ) + ) -getUserFullName <- function(shinySession = NULL) { - userInfo(shinySession, entity = "full_name") -} + if (length(units) != length(groups)) { + stop(paste( + "Vectors obtained from SHINYPROXY_USERGROUPS and USERORGID are of", + "different lengths. Hence, correspondence cannot be anticipated." + )) + } + ### DUE TO CURRENT LIMITATIONS TO FALK (currently application type OQR) ### + # HARD CODED ROLES HAVE TO BE MAPPED TO SHINYPROXY APPLICATION PRIVILEGES # + # THEREFORE, THE NEXT SECTION IS TO BE REMOVED ONCE A PROPER RAPPORTEKET # + # APPLICATION TYPE IS IN PLACE. # + ### ------------------- REMOVE THE SECTION BELOW! ------------------------- # + groups[groups == "LU"] <- "falkdemo" + groups[groups == "LC"] <- "ablanor" + groups[groups == "SC"] <- "rapadm" + + + # NB Anticipate that element positions in vectors do correspond! + ## filter by this group + units <- units[groups == group] + groups <- groups[groups == group] + + ## restrict when unit is provided + if (!is.null(unit)) { + groups <- groups[units == unit] + units <- units[units == unit] + } -#' Get user groups from config or session object -#' -#' This is a helper function for \code{\link{userInfo}}. When used without a -#' shiny session object calls to this function is made without any arguments. If -#' redefining contexts is needed, please use \code{\link{userInfo}} instead. -#' -#' @inheritParams userInfo -#' -#' @return String user name + # Look up org, role and unit name + orgs <- vector() + roles <- vector() + orgNames <- vector() + for (i in seq_len(length(units))) { + orgs[i] <- unitAttribute(units[i], "resh") + roles[i] <- unitAttribute(units[i], "role") + orgNames[i] <- unitAttribute(units[i], "titlewithpath") + } + + list( + name = rep(name, length(units)), + fullName = rep(fullName, length(units)), + phone = rep(phone, length(units)), + email = rep(email, length(units)), + group = groups, + unit = units, + org = orgs, + role = roles, + orgName = orgNames + ) +} + +#' Get unit attributes from an access tree file #' -#' @seealso \code{\link{getUserName}}, -#' \code{\link{getUserReshId}}, \code{\link{getUserRole}} +#' Obtain organization unit attributes from an access tree JSON file #' -#' @examples -#' \donttest{ -#' # Requires a valid shiny session object -#' try(getUserGroups()) -#' try(getUserGroups(shinySessionObject)) -#' } +#' @param unit Integer providing the look-up unit id +#' @param what Character string defining what to return for the given unit id +#' @param file Character string file name of the JSON file. Default values is +#' NULL in which case the corresponding value from rapbaseConfig.yml will be +#' used. +#' @param path Character string file path of the JSON file. Default value is +#' \code{Sys.getenv("R_RAP_CONFIG_PATH")}. #' +#' @return The corresponding value of 'what'. #' @export +unitAttribute <- function(unit, + what, + file = NULL, + path = Sys.getenv("R_RAP_CONFIG_PATH")) { + conf <- getConfig(fileName = "rapbaseConfig.yml")$accesstree -getUserGroups <- function(shinySession = NULL) { - userInfo(shinySession, entity = "groups") -} + if (is.null(file)) { + file <- conf$file + } + stopifnot(file.exists(file.path(path, file))) + if (!what %in% names(conf$list)) { + stop( + paste0( + "Argument what is not one of '", + paste0(names(conf$list), collapse = "', '"), + "'" + ) + ) + } -#' Get user name from config or session object -#' -#' This is a helper function for \code{\link{userInfo}}. When used without a -#' shiny session object calls to this function is made without any arguments. If -#' redefining contexts is needed, please use \code{\link{userInfo}} instead. -#' -#' @inheritParams userInfo -#' -#' @return String user name -#' -#' @seealso \code{\link{getUserGroups}}, -#' \code{\link{getUserReshId}}, \code{\link{getUserRole}} -#' -#' @examples -#' \donttest{ -#' # Requires a valid shiny session object -#' try(getUserName()) -#' try(getUserName(shinySessionObject)) -#' } -#' -#' @export + d <- jsonlite::read_json(file.path(path, file)) %>% + unlist() + ind <- as.vector(d[names(d) == conf$list$unit]) == unit -getUserName <- function(shinySession = NULL) { - userInfo(shinySession, entity = "user") + if (all(!ind)) { + warning( + paste0( + "Unit '", unit, "' was not found! Hence, your request for '", what, + "' will return empty!" + ) + ) + } + as.vector(d[names(d) == conf$list[[what]]][ind]) } -#' Get user phone (number) from config or session object -#' -#' This is a helper function for \code{\link{userInfo}}. When used without a -#' shiny session object calls to this function is made without any arguments. If -#' redefining contexts is needed, please use \code{\link{userInfo}} instead. +#' Get user attributes #' -#' @inheritParams userInfo +#' These are helper function for \code{\link{userInfo}}. When used without a +#' shiny session object calls to these functions is made without any arguments. +#' If redefining contexts is needed, please use \code{\link{userInfo}} instead. #' -#' @return String phone number +#' @param shinySession A shiny session object. Default value is NULL +#' @param group Character string providing the name of the app R package name. +#' The term "group" is used to relate to the environmental variable +#' SHINYPROXY_USERGROUPS that corresponds to the apps a given user can access. +#' Default value is NULL but should always be set when shiny app is run as a +#' shinyproxy container. #' -#' @seealso \code{\link{getUserName}}, -#' \code{\link{getUserGroups}}, \code{\link{getUserReshId}}, -#' \code{\link{getUserEmail}}, \code{\link{getUserFullName}} +#' @return String with user attribute +#' @name userAttribute +#' @aliases getUserEmail getUserFullName getUserGroups getUserName getUserPhone +#' getUserReshId getUserRole #' #' @examples #' \donttest{ #' # Requires a valid shiny session object -#' try(getUserPhone()) -#' try(getUserPhone(shinySessionObject)) +#' try(getUserEmail()) +#' try(getUserEmail(shinySessionObject)) #' } -#' +NULL + +#' @rdname userAttribute #' @export +getUserEmail <- function(shinySession = NULL, group = NULL) { + userInfo(shinySession, entity = "email", group = group) +} -getUserPhone <- function(shinySession = NULL) { - userInfo(shinySession, entity = "phone") +#' @rdname userAttribute +#' @export +getUserFullName <- function(shinySession = NULL, group = NULL) { + userInfo(shinySession, entity = "full_name", group = group) } -#' Get user resh ID from config or session object -#' -#' This is a helper function for \code{\link{userInfo}}. When used without a -#' shiny session object calls to this function is made without any arguments. If -#' redefining contexts is needed, please use \code{\link{userInfo}} instead. -#' -#' @inheritParams userInfo -#' -#' @return String user name -#' -#' @seealso \code{\link{getUserName}}, -#' \code{\link{getUserGroups}}, \code{\link{getUserRole}} -#' -#' @examples -#' \donttest{ -#' # Requires a valid shiny session object -#' try(getUserReshId()) -#' try(getUserReshId(shinySessionObject)) -#' } -#' +#' @rdname userAttribute #' @export +getUserGroups <- function(shinySession = NULL, group = NULL) { + userInfo(shinySession, entity = "groups", group = group) +} -getUserReshId <- function(shinySession = NULL) { - userInfo(shinySession, entity = "resh_id") +#' @rdname userAttribute +#' @export +getUserName <- function(shinySession = NULL, group = NULL) { + userInfo(shinySession, entity = "user", group = group) } -#' Get user role from config or session object -#' -#' This is a helper function for \code{\link{userInfo}}. When used without a -#' shiny session object calls to this function is made without any arguments. If -#' redefining contexts is needed, please use \code{\link{userInfo}} instead. -#' -#' @inheritParams userInfo -#' -#' @return String user name -#' -#' @seealso \code{\link{getUserName}}, -#' \code{\link{getUserGroups}}, \code{\link{getUserReshId}} -#' -#' @examples -#' \donttest{ -#' # Requires a valid shiny session object -#' try(getUserRole()) -#' try(getUserRole(shinySessionObject)) -#' } -#' +#' @rdname userAttribute #' @export +getUserPhone <- function(shinySession = NULL, group = NULL) { + userInfo(shinySession, entity = "phone", group = group) +} + + +#' @rdname userAttribute +#' @export +getUserReshId <- function(shinySession = NULL, group = NULL) { + userInfo(shinySession, entity = "resh_id", group = group) +} -getUserRole <- function(shinySession = NULL) { - userInfo(shinySession, entity = "role") +#' @rdname userAttribute +#' @export +getUserRole <- function(shinySession = NULL, group = NULL) { + userInfo(shinySession, entity = "role", group = group) } diff --git a/_pkgdown.yml b/_pkgdown.yml index 4613ffd6..8e113148 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -44,6 +44,8 @@ reference: - getUserPhone - getUserEmail - userInfo + - unitAttribute + - userAttribute - title: Logging desc: > diff --git a/data-raw/accesstree.R b/data-raw/accesstree.R new file mode 100644 index 00000000..2d6caf40 --- /dev/null +++ b/data-raw/accesstree.R @@ -0,0 +1,109 @@ +j <- ' +{ + "AccessUnits": [ + { + "UnitId": 1, + "ParentUnitId": 0, + "HasDatabase": true, + "ExternalId": 100082, + "HealthUnitId": 100082, + "Title": "Helse Bergen HF - LU", + "TitleWithPath": "Helse Bergen HF", + "ValidFrom": null, + "ValidTo": null, + "ExtraData": "LU" + }, + { + "UnitId": 2, + "ParentUnitId": 1, + "HasDatabase": true, + "ExternalId": 102966, + "HealthUnitId": 102966, + "Title": "HB Hjerteavdelingen - SC", + "TitleWithPath": "Helse Bergen HF - HB Hjerteavdelingen", + "ValidFrom": null, + "ValidTo": null, + "ExtraData": "SC" + }, + { + "UnitId": 3, + "ParentUnitId": 0, + "HasDatabase": true, + "ExternalId": 4001031, + "HealthUnitId": 4001031, + "Title": "Oslo universitetssykehus HF - SC", + "TitleWithPath": "Oslo universitetssykehus HF", + "ValidFrom": null, + "ValidTo": null, + "ExtraData": "SC" + }, + { + "UnitId": 4, + "ParentUnitId": 3, + "HasDatabase": true, + "ExternalId": 700328, + "HealthUnitId": 700328, + "Title": "Hjerte-, lunge- og karklinikken - LU", + "TitleWithPath": "Oslo universitetssykehus HF - Hjerte-, lunge- og karklinikken", + "ValidFrom": null, + "ValidTo": null, + "ExtraData": "LU" + }, + { + "UnitId": 5, + "ParentUnitId": 0, + "HasDatabase": true, + "ExternalId": 100320, + "HealthUnitId": 100320, + "Title": "St. Olavs Hospital HF - SC", + "TitleWithPath": "St. Olavs Hospital HF", + "ValidFrom": null, + "ValidTo": null, + "ExtraData": "SC" + }, + { + "UnitId": 6, + "ParentUnitId": 5, + "HasDatabase": true, + "ExternalId": 104284, + "HealthUnitId": 104284, + "Title": "Klinikk for Hjertemedisin - LU", + "TitleWithPath": "St. Olavs Hospital HF - Klinikk for Hjertemedisin", + "ValidFrom": null, + "ValidTo": null, + "ExtraData": "LU" + }, + { + "UnitId": 7, + "ParentUnitId": 0, + "HasDatabase": true, + "ExternalId": 106944, + "HealthUnitId": 106944, + "Title": "AHUS Gardermoen - SC", + "TitleWithPath": "AHUS Gardermoen", + "ValidFrom": null, + "ValidTo": null, + "ExtraData": "SC" + }, + { + "UnitId": 8, + "ParentUnitId": 7, + "HasDatabase": true, + "ExternalId": 4214492, + "HealthUnitId": 4214492, + "Title": "Hjertemedisinsk avdeling - LU", + "TitleWithPath": "AHUS Gardermoen - Hjertemedisinsk avdeling", + "ValidFrom": null, + "ValidTo": null, + "ExtraData": "LU" + } + ] + } +' + +accesstree <- jsonlite::parse_json(j) + +# Store it as an external data set in this package, please adjust path +# accordingly + +# jsonlite::write_json(accesstree, "./inst/extdata/accesstree.json") diff --git a/inst/extdata/accesstree.json b/inst/extdata/accesstree.json new file mode 100644 index 00000000..d24b4f8f --- /dev/null +++ b/inst/extdata/accesstree.json @@ -0,0 +1 @@ +{"AccessUnits":[{"UnitId":[1],"ParentUnitId":[0],"HasDatabase":[true],"ExternalId":[100082],"HealthUnitId":[100082],"Title":["Helse Bergen HF - LU"],"TitleWithPath":["Helse Bergen HF"],"ValidFrom":{},"ValidTo":{},"ExtraData":["LU"]},{"UnitId":[2],"ParentUnitId":[1],"HasDatabase":[true],"ExternalId":[102966],"HealthUnitId":[102966],"Title":["HB Hjerteavdelingen - SC"],"TitleWithPath":["Helse Bergen HF - HB Hjerteavdelingen"],"ValidFrom":{},"ValidTo":{},"ExtraData":["SC"]},{"UnitId":[3],"ParentUnitId":[0],"HasDatabase":[true],"ExternalId":[4001031],"HealthUnitId":[4001031],"Title":["Oslo universitetssykehus HF - SC"],"TitleWithPath":["Oslo universitetssykehus HF"],"ValidFrom":{},"ValidTo":{},"ExtraData":["SC"]},{"UnitId":[4],"ParentUnitId":[3],"HasDatabase":[true],"ExternalId":[700328],"HealthUnitId":[700328],"Title":["Hjerte-, lunge- og karklinikken - LU"],"TitleWithPath":["Oslo universitetssykehus HF - Hjerte-, lunge- og karklinikken"],"ValidFrom":{},"ValidTo":{},"ExtraData":["LU"]},{"UnitId":[5],"ParentUnitId":[0],"HasDatabase":[true],"ExternalId":[100320],"HealthUnitId":[100320],"Title":["St. Olavs Hospital HF - SC"],"TitleWithPath":["St. Olavs Hospital HF"],"ValidFrom":{},"ValidTo":{},"ExtraData":["SC"]},{"UnitId":[6],"ParentUnitId":[5],"HasDatabase":[true],"ExternalId":[104284],"HealthUnitId":[104284],"Title":["Klinikk for Hjertemedisin - LU"],"TitleWithPath":["St. Olavs Hospital HF - Klinikk for Hjertemedisin"],"ValidFrom":{},"ValidTo":{},"ExtraData":["LU"]},{"UnitId":[7],"ParentUnitId":[0],"HasDatabase":[true],"ExternalId":[106944],"HealthUnitId":[106944],"Title":["AHUS Gardermoen - SC"],"TitleWithPath":["AHUS Gardermoen"],"ValidFrom":{},"ValidTo":{},"ExtraData":["SC"]},{"UnitId":[8],"ParentUnitId":[7],"HasDatabase":[true],"ExternalId":[4214492],"HealthUnitId":[4214492],"Title":["Hjertemedisinsk avdeling - LU"],"TitleWithPath":["AHUS Gardermoen - Hjertemedisinsk avdeling"],"ValidFrom":{},"ValidTo":{},"ExtraData":["LU"]}]} diff --git a/inst/rapbaseConfig.yml b/inst/rapbaseConfig.yml index 65f1d2ba..ea1045a5 100644 --- a/inst/rapbaseConfig.yml +++ b/inst/rapbaseConfig.yml @@ -99,3 +99,18 @@ db : user : rapbase pass : rapbase disp : ForTestingOnly + +## Access tree +accesstree: + file: accesstree.json + list: + unit: AccessUnits.UnitId + resh: AccessUnits.HealthUnitId + role: AccessUnits.ExtraData + parent: AccessUnits.ParentUnitId + database: AccessUnits.HasDatabase + external: AccessUnits.ExternalId + title: AccessUnits.Title + titlewithpath: AccessUnits.TitleWithPath + validfrom: AccessUnits.ValidFrom + validto: AccessUnits.ValidTo diff --git a/man/appNavbarUserWidget.Rd b/man/appNavbarUserWidget.Rd index 92d809e8..1fa7920f 100644 --- a/man/appNavbarUserWidget.Rd +++ b/man/appNavbarUserWidget.Rd @@ -8,6 +8,7 @@ appNavbarUserWidget( user = "Undefined person", organization = "Undefined organization", addUserInfo = FALSE, + selectOrganization = FALSE, namespace = NULL ) } @@ -19,6 +20,8 @@ appNavbarUserWidget( \item{addUserInfo}{Logical defining whether a user data pop-up is to be part of the widget (TRUE) or not (FALSE, default)} +\item{selectOrganization}{Logical if organization can be selected.} + \item{namespace}{Character string providing the namespace to use, if any. Defaults is \code{NULL} in which case no namespace will be applied.} } diff --git a/man/autoReport.Rd b/man/autoReport.Rd index 55dbd570..ad0daa7d 100644 --- a/man/autoReport.Rd +++ b/man/autoReport.Rd @@ -12,6 +12,7 @@ \alias{autoReportApp} \alias{orgList2df} \alias{autoReportFormatServer} +\alias{autoReportServer2} \title{Shiny modules and helper functions for registry auto reports} \usage{ autoReportUI(id) @@ -39,6 +40,20 @@ autoReportServer( freq = "month" ) +autoReportServer2( + id, + registryName, + type, + org = NULL, + paramNames = shiny::reactiveVal(c("")), + paramValues = shiny::reactiveVal(c("")), + reports = NULL, + orgs = NULL, + eligible = TRUE, + freq = "month", + user +) + autoReportApp( registryName = "rapbase", type = "subscription", @@ -65,10 +80,10 @@ of \code{c("subscription", "dispatchment", "bulletin")}} \item{org}{Shiny reactive or NULL (default) defining the organization (id) of the data source used for dispatchments and bulletins (in which case it cannot be set to NULL) and its value will be used to populate the -\emph{organization} field in auto report data (autoReport.yml) for these auto -report types. On the other hand, since subscriptions are personal (per user) -the only relevant organization id will implicit be that of the user and in -this case any value of \code{org} will be disregarded.} +\emph{organization} field in auto report data (autoReport.yml) for these +auto report types. On the other hand, since subscriptions are personal +(per user) the only relevant organization id will implicit be that of the +user and in this case any value of \code{org} will be disregarded.} \item{paramNames}{Shiny reactive value as a vector of parameter names of which values are to be set interactively at application run time. Each @@ -77,24 +92,28 @@ Default value is \code{shiny::reactiveVal("")}.} \item{paramValues}{Shiny reactive value as a vector of those parameter values to be set interactively, \emph{i.e.} as per user input in the application. -Default value is set to \code{shiny::reactiveVal("")} in which case parameter -values defined in \code{reports} will be used as is. In other words, -explicit use of \code{paramValues} will only be needed if parameter values -must be changed during application run time. If so, each element of this -vector must correspond exactly to those of \code{paramNames}.} +Default value is set to \code{shiny::reactiveVal("")} in which case +parameter values defined in \code{reports} will be used as is. In other +words, explicit use of \code{paramValues} will only be needed if parameter +values must be changed during application run time. If so, each element of +this vector must correspond exactly to those of \code{paramNames}.} \item{reports}{List of a given structure that provides meta data for the -reports that are made available as automated reports. See Details for further -description.} +reports that are made available as automated reports. See Details for +further description.} \item{eligible}{Logical defining if the module should be allowed to work at -full capacity. This might be useful when access to module products should be -restricted. Default is TRUE, \emph{i.e.} no restrictions.} +full capacity. This might be useful when access to module products should +be restricted. Default is TRUE, \emph{i.e.} no restrictions.} \item{freq}{Character string defining default frequency set in the auto report GUI. Must be one of \code{c("day", "week", "month", "quarter", "year")}. Default value is "month".} + +\item{user}{List of shiny reactive values providing user metadata and +privileges corresponding to the return value of +\code{\link{navbarWidgetServer}}.} } \value{ In general, shiny objects. In particular, \code{autoreportOrgServer} @@ -125,10 +144,10 @@ These named values will be used to run reports none-interactively on a given schedule and must therefore represent existing and exported functions from the registry R package. For subscriptions the \emph{reports} list can be used as is, more specifically that the values provided in \emph{paramValues} can -go unchanged. For dispatchments and bulletins it is likely that parameter -values must be set dynamically in which case \emph{paramValues} must be -a reactive part of the application. See Examples on how function arguments -may be used as reactives in an application. +go unchanged. It is likely that parameter values must be set dynamically at +runtime in which case \emph{paramValues} must be a reactive part of the +application. See Examples on how function arguments may be used as reactives +in an application. } \examples{ ## make a list for report metadata diff --git a/man/getSessionData.Rd b/man/getSessionData.Rd index fed118c2..3e8061e6 100644 --- a/man/getSessionData.Rd +++ b/man/getSessionData.Rd @@ -4,10 +4,14 @@ \alias{getSessionData} \title{Get session data} \usage{ -getSessionData(session) +getSessionData(session, group = NULL) } \arguments{ \item{session}{A shiny session object} + +\item{group}{Character string providing the name of the app R package name. +The term "group" is used to relate to the environmental variable +SHINYPROXY_USERGROUPS that corresponds to the apps a given user can access.} } \value{ A list of relevant log fields diff --git a/man/getUserEmail.Rd b/man/getUserEmail.Rd deleted file mode 100644 index ebfc8afe..00000000 --- a/man/getUserEmail.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/userAttribute.R -\name{getUserEmail} -\alias{getUserEmail} -\title{Get user email from config or session object} -\usage{ -getUserEmail(shinySession = NULL) -} -\arguments{ -\item{shinySession}{Shiny session object (list, NULL by default). Must be -provided when the source of user attributes is either the shiny app url or -an external authentication provider. By default this will apply to the -'TEST', 'QA' and 'PRODUCTION' contexts in which case the shiny session -object must be provided.} -} -\value{ -String email address -} -\description{ -This is a helper function for \code{\link{userInfo}}. When used without a -shiny session object calls to this function is made without any arguments. If -redefining contexts is needed, please use \code{\link{userInfo}} instead. -} -\examples{ -\donttest{ -# Requires a valid shiny session object -try(getUserEmail()) -try(getUserEmail(shinySessionObject)) -} - -} -\seealso{ -\code{\link{getUserName}}, -\code{\link{getUserGroups}}, \code{\link{getUserReshId}}, -\code{\link{getUserEmail}} -} diff --git a/man/getUserFullName.Rd b/man/getUserFullName.Rd deleted file mode 100644 index a670fdf6..00000000 --- a/man/getUserFullName.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/userAttribute.R -\name{getUserFullName} -\alias{getUserFullName} -\title{Get user full name from config or session object} -\usage{ -getUserFullName(shinySession = NULL) -} -\arguments{ -\item{shinySession}{Shiny session object (list, NULL by default). Must be -provided when the source of user attributes is either the shiny app url or -an external authentication provider. By default this will apply to the -'TEST', 'QA' and 'PRODUCTION' contexts in which case the shiny session -object must be provided.} -} -\value{ -String full name -} -\description{ -This is a helper function for \code{\link{userInfo}}. When used without a -shiny session object calls to this function is made without any arguments. If -redefining contexts is needed, please use \code{\link{userInfo}} instead. -} -\examples{ -\donttest{ -# Requires a valid shiny session object -try(getUserFullName()) -try(getUserFullName(shinySessionObject)) -} - -} -\seealso{ -\code{\link{getUserName}}, -\code{\link{getUserGroups}}, \code{\link{getUserReshId}}, -\code{\link{getUserEmail}}, \code{\link{getUserPhone}} -} diff --git a/man/getUserGroups.Rd b/man/getUserGroups.Rd deleted file mode 100644 index 12ebb5a2..00000000 --- a/man/getUserGroups.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/userAttribute.R -\name{getUserGroups} -\alias{getUserGroups} -\title{Get user groups from config or session object} -\usage{ -getUserGroups(shinySession = NULL) -} -\arguments{ -\item{shinySession}{Shiny session object (list, NULL by default). Must be -provided when the source of user attributes is either the shiny app url or -an external authentication provider. By default this will apply to the -'TEST', 'QA' and 'PRODUCTION' contexts in which case the shiny session -object must be provided.} -} -\value{ -String user name -} -\description{ -This is a helper function for \code{\link{userInfo}}. When used without a -shiny session object calls to this function is made without any arguments. If -redefining contexts is needed, please use \code{\link{userInfo}} instead. -} -\examples{ -\donttest{ -# Requires a valid shiny session object -try(getUserGroups()) -try(getUserGroups(shinySessionObject)) -} - -} -\seealso{ -\code{\link{getUserName}}, -\code{\link{getUserReshId}}, \code{\link{getUserRole}} -} diff --git a/man/getUserName.Rd b/man/getUserName.Rd deleted file mode 100644 index 36e376cd..00000000 --- a/man/getUserName.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/userAttribute.R -\name{getUserName} -\alias{getUserName} -\title{Get user name from config or session object} -\usage{ -getUserName(shinySession = NULL) -} -\arguments{ -\item{shinySession}{Shiny session object (list, NULL by default). Must be -provided when the source of user attributes is either the shiny app url or -an external authentication provider. By default this will apply to the -'TEST', 'QA' and 'PRODUCTION' contexts in which case the shiny session -object must be provided.} -} -\value{ -String user name -} -\description{ -This is a helper function for \code{\link{userInfo}}. When used without a -shiny session object calls to this function is made without any arguments. If -redefining contexts is needed, please use \code{\link{userInfo}} instead. -} -\examples{ -\donttest{ -# Requires a valid shiny session object -try(getUserName()) -try(getUserName(shinySessionObject)) -} - -} -\seealso{ -\code{\link{getUserGroups}}, -\code{\link{getUserReshId}}, \code{\link{getUserRole}} -} diff --git a/man/getUserPhone.Rd b/man/getUserPhone.Rd deleted file mode 100644 index 75cb74a4..00000000 --- a/man/getUserPhone.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/userAttribute.R -\name{getUserPhone} -\alias{getUserPhone} -\title{Get user phone (number) from config or session object} -\usage{ -getUserPhone(shinySession = NULL) -} -\arguments{ -\item{shinySession}{Shiny session object (list, NULL by default). Must be -provided when the source of user attributes is either the shiny app url or -an external authentication provider. By default this will apply to the -'TEST', 'QA' and 'PRODUCTION' contexts in which case the shiny session -object must be provided.} -} -\value{ -String phone number -} -\description{ -This is a helper function for \code{\link{userInfo}}. When used without a -shiny session object calls to this function is made without any arguments. If -redefining contexts is needed, please use \code{\link{userInfo}} instead. -} -\examples{ -\donttest{ -# Requires a valid shiny session object -try(getUserPhone()) -try(getUserPhone(shinySessionObject)) -} - -} -\seealso{ -\code{\link{getUserName}}, -\code{\link{getUserGroups}}, \code{\link{getUserReshId}}, -\code{\link{getUserEmail}}, \code{\link{getUserFullName}} -} diff --git a/man/getUserReshId.Rd b/man/getUserReshId.Rd deleted file mode 100644 index 076e85ed..00000000 --- a/man/getUserReshId.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/userAttribute.R -\name{getUserReshId} -\alias{getUserReshId} -\title{Get user resh ID from config or session object} -\usage{ -getUserReshId(shinySession = NULL) -} -\arguments{ -\item{shinySession}{Shiny session object (list, NULL by default). Must be -provided when the source of user attributes is either the shiny app url or -an external authentication provider. By default this will apply to the -'TEST', 'QA' and 'PRODUCTION' contexts in which case the shiny session -object must be provided.} -} -\value{ -String user name -} -\description{ -This is a helper function for \code{\link{userInfo}}. When used without a -shiny session object calls to this function is made without any arguments. If -redefining contexts is needed, please use \code{\link{userInfo}} instead. -} -\examples{ -\donttest{ -# Requires a valid shiny session object -try(getUserReshId()) -try(getUserReshId(shinySessionObject)) -} - -} -\seealso{ -\code{\link{getUserName}}, -\code{\link{getUserGroups}}, \code{\link{getUserRole}} -} diff --git a/man/getUserRole.Rd b/man/getUserRole.Rd deleted file mode 100644 index b880a4f1..00000000 --- a/man/getUserRole.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/userAttribute.R -\name{getUserRole} -\alias{getUserRole} -\title{Get user role from config or session object} -\usage{ -getUserRole(shinySession = NULL) -} -\arguments{ -\item{shinySession}{Shiny session object (list, NULL by default). Must be -provided when the source of user attributes is either the shiny app url or -an external authentication provider. By default this will apply to the -'TEST', 'QA' and 'PRODUCTION' contexts in which case the shiny session -object must be provided.} -} -\value{ -String user name -} -\description{ -This is a helper function for \code{\link{userInfo}}. When used without a -shiny session object calls to this function is made without any arguments. If -redefining contexts is needed, please use \code{\link{userInfo}} instead. -} -\examples{ -\donttest{ -# Requires a valid shiny session object -try(getUserRole()) -try(getUserRole(shinySessionObject)) -} - -} -\seealso{ -\code{\link{getUserName}}, -\code{\link{getUserGroups}}, \code{\link{getUserReshId}} -} diff --git a/man/logger.Rd b/man/logger.Rd index 167e9bbc..1761fe77 100644 --- a/man/logger.Rd +++ b/man/logger.Rd @@ -7,7 +7,12 @@ \alias{autLogger} \title{Log user events in shiny applications at Rapporteket} \usage{ -appLogger(session, msg = "No message provided") +appLogger( + session, + msg = "No message provided", + .topcall = sys.call(-1), + .topenv = parent.frame() +) repLogger( session, diff --git a/man/makeAutoReportTab.Rd b/man/makeAutoReportTab.Rd index e3cf4160..45ca4b70 100644 --- a/man/makeAutoReportTab.Rd +++ b/man/makeAutoReportTab.Rd @@ -7,6 +7,9 @@ makeAutoReportTab( session, namespace = character(), + user = rapbase::getUserName(session), + group = rapbase::getUserGroups(session), + orgId = rapbase::getUserReshId(session), type = "subscription", mapOrgId = NULL, includeReportId = FALSE @@ -16,8 +19,22 @@ makeAutoReportTab( \item{session}{A shiny session object} \item{namespace}{String naming namespace. Defaults to \code{character()} in -which case no namespace will be created. When this function is used by shiny -modules namespace must be provided.} +which case no namespace will be created. When this function is used by +shiny modules namespace must be provided.} + +\item{user}{Character string providing the username. Introduced as a new +argument when running apps inside containers. Default value is set to +\code{rapbase::getUserName(session)} to allow backward compatibility.} + +\item{group}{Character string defining the registry, normally corresponding +to the R package name and the value stemming from the SHINYPROXY_GROUPS +environment variable. Introduced as a new argument when running apps inside +containers. Default value is set to \code{rapbase::getUserGroups(session)} +to allow backward compatibility.} + +\item{orgId}{Character string or integer defining the organization (id) for +\code{user}. Default value is set to \code{rapbase::getUserReshId(session)} +to allow backward compatibility.} \item{type}{Character string defining the type of auto reports to tabulate. Must be one of \code{"subscription"}, \code{"dispatchment"} or @@ -38,7 +55,7 @@ Matrix providing a table to be rendered in a shiny app \description{ Make a table to be rendered in a shiny app providing automated reports from a given user or registry as obtained from the shiny session -object provided. +object provided or environmental variables when run inside an app container. } \details{ Each table record (line) represents a uniquely defined automated report. diff --git a/man/navbarWidget.Rd b/man/navbarWidget.Rd index d497a763..5d5163ec 100644 --- a/man/navbarWidget.Rd +++ b/man/navbarWidget.Rd @@ -3,14 +3,21 @@ \name{navbarWidget} \alias{navbarWidget} \alias{navbarWidgetInput} -\alias{navbarWidgetServer} +\alias{navbarWidgetServer2} \alias{navbarWidgetApp} +\alias{navbarWidgetServer} \title{Shiny modules providing GUI and server logic for user info widget} \usage{ -navbarWidgetInput(id, addUserInfo = TRUE) +navbarWidgetInput(id, addUserInfo = TRUE, selectOrganization = FALSE) navbarWidgetServer(id, orgName, caller = environmentName(rlang::caller_env())) +navbarWidgetServer2( + id, + orgName, + caller = environmentName(topenv(parent.frame())) +) + navbarWidgetApp(orgName = "Org Name") } \arguments{ @@ -18,18 +25,24 @@ navbarWidgetApp(orgName = "Org Name") \item{addUserInfo}{Logical defining if an "about" hyperlink is to be added} +\item{selectOrganization}{Logical providing option for selecting among +available organizations and roles.} + \item{orgName}{Character string naming the organization} \item{caller}{Character string naming the environment this function was -called from. Default value is \code{environmentName(rlang::caller_env())}. -The value is used to display the current version of the R package -representing the registry at Rapporteket. If this module is called from -exported functions in the registry R package use the default value. If the -module is called from outside the registry environment \code{caller} must be -set to the actual name of the R package.} +called from. Default value is +\code{environmentName(topenv(parent.frame()))}. The value is used to +display the current version of the R package representing the registry at +Rapporteket. If this module is called from exported functions in the +registry R package the default value should be applied. If the module is +called from outside the registry environment \code{caller} must be set to +the actual name of the R package.} } \value{ -Shiny objects, mostly. Helper functions may return other stuff too. +Shiny objects, mostly. \code{navbarWidgetServer()} invisibly returns +a list of reactive values representing user metadata and privileges. See +\code{\link{userAttribute}} for further details on these values. } \description{ Shiny modules for making a user information widget in registry shiny apps at diff --git a/man/unitAttribute.Rd b/man/unitAttribute.Rd new file mode 100644 index 00000000..dd01ea69 --- /dev/null +++ b/man/unitAttribute.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/userAttribute.R +\name{unitAttribute} +\alias{unitAttribute} +\title{Get unit attributes from an access tree file} +\usage{ +unitAttribute(unit, what, file = NULL, path = Sys.getenv("R_RAP_CONFIG_PATH")) +} +\arguments{ +\item{unit}{Integer providing the look-up unit id} + +\item{what}{Character string defining what to return for the given unit id} + +\item{file}{Character string file name of the JSON file. Default values is +NULL in which case the corresponding value from rapbaseConfig.yml will be +used.} + +\item{path}{Character string file path of the JSON file. Default value is +\code{Sys.getenv("R_RAP_CONFIG_PATH")}.} +} +\value{ +The corresponding value of 'what'. +} +\description{ +Obtain organization unit attributes from an access tree JSON file +} diff --git a/man/userAttribute.Rd b/man/userAttribute.Rd new file mode 100644 index 00000000..393d4491 --- /dev/null +++ b/man/userAttribute.Rd @@ -0,0 +1,74 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/userAttribute.R +\name{userAttribute} +\alias{userAttribute} +\alias{getUserEmail} +\alias{getUserFullName} +\alias{getUserGroups} +\alias{getUserName} +\alias{getUserPhone} +\alias{getUserReshId} +\alias{getUserRole} +\title{User attributes in container apps running behind shinyproxy} +\usage{ +userAttribute(group, unit = NULL) + +getUserEmail(shinySession = NULL, group = NULL) + +getUserFullName(shinySession = NULL, group = NULL) + +getUserGroups(shinySession = NULL, group = NULL) + +getUserName(shinySession = NULL, group = NULL) + +getUserPhone(shinySession = NULL, group = NULL) + +getUserReshId(shinySession = NULL, group = NULL) + +getUserRole(shinySession = NULL, group = NULL) +} +\arguments{ +\item{group}{Character string providing the name of the app R package name. +The term "group" is used to relate to the environmental variable +SHINYPROXY_USERGROUPS that corresponds to the apps a given user can access. +Default value is NULL but should always be set when shiny app is run as a +shinyproxy container.} + +\item{unit}{Integer providing the look-up unit id. Default value is NULL in +which case all privileges for \code{group} are returned.} + +\item{shinySession}{A shiny session object. Default value is NULL} +} +\value{ +Invisibly a list of user metadata and privileges: + \describe{ + \item{name}{The username for whom the privileges apply.} + \item{fullName}{User full name} + \item{phone}{User phone number} + \item{email}{User email} + \item{group}{Group of which the user is a member.} + \item{unit}{Unit id under which the privileges are defined.} + \item{org}{Organization id for the user.} + \item{role}{Role of the user.} + \item{orgName}{Name of the organization as defined under the unit id.} + } + +String with user attribute +} +\description{ +For apps running as containers particular environment variables must be +defined for an orderly handling of dynamic user privileges. This function +makes use of environmental variables defined by shinyproxy to provide +available privileges for the shiny application. + +These are helper function for \code{\link{userInfo}}. When used without a +shiny session object calls to these functions is made without any arguments. +If redefining contexts is needed, please use \code{\link{userInfo}} instead. +} +\examples{ +\donttest{ +# Requires a valid shiny session object +try(getUserEmail()) +try(getUserEmail(shinySessionObject)) +} +} diff --git a/man/userInfo.Rd b/man/userInfo.Rd index 3796a352..697c92fb 100644 --- a/man/userInfo.Rd +++ b/man/userInfo.Rd @@ -9,12 +9,13 @@ userInfo( shinySession = NULL, devContexts = c("DEV"), testContexts = c("TEST"), - prodContexts = c("QA", "PRODUCTION") + prodContexts = c("QA", "QAC", "PRODUCTION", "PRODUCTIONC"), + group = NULL ) } \arguments{ \item{entity}{String defining the element to return. Currently, one of -'user', groups', 'resh_id', 'role', 'email', 'full_name' or 'phone'} +'user', groups', 'resh_id', 'role', 'email', 'full_name' or 'phone'.} \item{shinySession}{Shiny session object (list, NULL by default). Must be provided when the source of user attributes is either the shiny app url or @@ -25,36 +26,42 @@ object must be provided.} \item{devContexts}{A character vector providing unique instances to be regarded as a development context. In this context user attributes will be read from configuration as provided by 'rapbaseConfig.yml'. The instances -provided cannot overlap instances provided in any other contexts. By default -set to \code{c("DEV")}.} +provided cannot overlap instances provided in any other contexts. By +default set to \code{c("DEV")}.} \item{testContexts}{A character vector providing unique instances to be regarded as a test context. In this context user attributes will be read from the url call to a shiny application. Hence, for this context the corresponding shiny session object must also be provided. The instances -provided cannot overlap instances provided in any other contexts. By default -set to \code{c("TEST")}.} +provided cannot overlap instances provided in any other contexts. By +default set to \code{c("TEST")}.} \item{prodContexts}{A character vector providing unique instances to be regarded as a production context. In this context user attributes will be -read from the shiny session object (as shiny server interacts with an -external log-in service). Hence, for this context the corresponding shiny -session object must also be provided. The instances provided cannot overlap -instances provided in any other contexts. By default set to -\code{c("QA", "PRODUCTION")}.} +read from the shiny session object (on deployment in shiny-server) or, from +environmental variables (on standalone container deployment). Hence, for +this context the corresponding shiny session object must also be provided. +Instances provided cannot overlap instances in any other contexts. By +default set to \code{c("QA", "QAC", "PRODUCTION", "PRODUCTIONC")}. +Duplication as seen by the "C" suffix will be needed as long as apps in +question are to be run on both shiny-server and as standalone containers.} + +\item{group}{Character string providing the name of the app R package name. +The term "group" is used to relate to the environmental variable +SHINYPROXY_USERGROUPS that corresponds to the apps a given user can access.} } \value{ String of single user data element } \description{ -Extracts elements from either config, url (shiny) or session (shiny) -relevant for user data such as name, group, role and reshId. Source of info -is based on environment context and can be controlled by altering the default -settings for which contexts that will apply for the various sources of user -data. This function will normally be used via its helper functions (see -below). +Extracts elements from either config, url (shiny), shiny session or +environmental variables relevant for user data such as name, group, role and +org id (\emph{e.g.} resh id). Source of info is based on environment context +and can be controlled by altering the default settings for which contexts +that will apply for the various sources of user data. This function will +normally be used via its helper functions (see below). } \seealso{ \code{\link{getUserName}}, \code{\link{getUserGroups}}, -\code{\link{getUserReshId}}, \code{\link{getUserRole}} + \code{\link{getUserReshId}}, \code{\link{getUserRole}} } diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 07b642cb..3483fe9c 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -1 +1,2 @@ library(httptest) +library(withr) diff --git a/tests/testthat/test-moduleAutoReport.R b/tests/testthat/test-moduleAutoReport.R index 82320348..78584af7 100644 --- a/tests/testthat/test-moduleAutoReport.R +++ b/tests/testthat/test-moduleAutoReport.R @@ -300,5 +300,279 @@ test_that("test app returns an app object", { expect_equal(class(autoReportApp()), "shiny.appobj") }) +## Duplicate for shinyproxy container instance +file.copy( + system.file( + c("autoReport.yml", "extdata/accesstree.json"), + package = "rapbase" + ), + Sys.getenv("R_RAP_CONFIG_PATH") +) +with_envvar( + new = c( + "R_RAP_INSTANCE" = "QAC", + "SHINYPROXY_USERNAME" = "ttesterc", + "SHINYPROXY_USERGROUPS" = "rapbase,rapbase,utils,utils", + "USERORGID" = "[1, 2, 3, 4]", + "USERFULLNAME" = "Tore Tester Container", + "USEREMAIL" = "ttesterc@rapporteket.no" + ), + code = { + ## make a list for report metadata + reports <- list( + FirstReport = list( + synopsis = "First example report", + fun = "fun1", + paramNames = c("organization", "outputFormat"), + paramValues = c(100082, "html") + ), + SecondReport = list( + synopsis = "Second example report", + fun = "fun2", + paramNames = c("organization", "outputFormat"), + paramValues = c(102966, "pdf") + ) + ) + ## make a list of organization names and numbers + orgs <- list( + OrgOne = 100082, + OrgTwo = 102966 + ) + type <- "subscription" + user <- userAttribute("rapbase", unit = 1) + for (n in names(user)) { + user[[n]] <- shiny::reactiveVal(user[[n]]) + } + + test_that("module server provides sensible output", { + shiny::testServer(autoReportServer2, + args = list( + registryName = registryName, type = type, + reports = reports, orgs = orgs, user = user + ), + { + session$setInputs(report = "FirstReport") + expect_equal(class(output$reports), "list") + } + ) + }) + + test_that("no report select list created when no reports available", { + shiny::testServer( + autoReportServer2, + args = list( + registryName = registryName, type = type, + reports = NULL, orgs = orgs, user = user + ), + { + expect_true(is.null(output$reports)) + } + ) + }) + + type <- "dispatchment" + test_that("email can be added and deleted for dispatchment", { + shiny::testServer( + autoReportServer2, + args = list( + registryName = registryName, type = type, + org = shiny::reactive(100082), + reports = reports, orgs = orgs, user = user + ), + { + session$setInputs(email = "true@email.no") + expect_equal(length(autoReport$email), 0) + session$setInputs(addEmail = 1) + expect_equal(autoReport$email[1], "true@email.no") + session$setInputs(delEmail = 1) + expect_equal(length(autoReport$email), 0) + } + ) + }) + + + test_that("new dispatchment can be written to and removed from file", { + origFileSize <- file.size(file.path( + Sys.getenv("R_RAP_CONFIG_PATH"), + "autoReport.yml" + )) + shiny::testServer( + autoReportServer2, + args = list( + registryName = registryName, type = type, + org = shiny::reactive(100082), + reports = reports, orgs = orgs, freq = "year", user = user + ), + { + user$role <- shiny::reactive("SC") + session$flushReact() + print(autoReport$tab) + session$setInputs(report = "FirstReport") + session$setInputs(freq = "Aarlig-year") + session$setInputs(start = as.character(Sys.Date())) + session$setInputs(email = "true@email.no") + session$setInputs(addEmail = 1) + session$setInputs(makeAutoReport = 1) + expect_true(origFileSize < file.size( + file.path( + Sys.getenv("R_RAP_CONFIG_PATH"), + "autoReport.yml" + ) + )) + + # get newly created edit button id (from last entry in table) + # and test it by entry being removed from table + btnRaw <- autoReport$tab[dim(autoReport$tab)[1], ]$Endre + editButton <- rvest::read_html(btnRaw) %>% + rvest::html_element("button") %>% + rvest::html_attr("id") + repsBefore <- dim(autoReport$tab)[1] + session$setInputs(edit_button = editButton) + repsAfter <- dim(autoReport$tab)[1] + expect_true(repsAfter == (repsBefore - 1)) + # then, true deletion (after adding one more time) + session$setInputs(makeAutoReport = 2) + expect_true(repsBefore == dim(autoReport$tab)[1]) + btnRaw <- autoReport$tab[dim(autoReport$tab)[1], ]$Slett + delButton <- rvest::read_html(btnRaw) %>% + rvest::html_element("button") %>% + rvest::html_attr("id") + session$setInputs(del_button = delButton) + repsAfter <- dim(autoReport$tab)[1] + expect_true(repsAfter == (repsBefore - 1)) + } + ) + }) + + test_that("paramValues can be tweaked when provided", { + origFileSize <- file.size(file.path( + Sys.getenv("R_RAP_CONFIG_PATH"), + "autoReport.yml" + )) + shiny::testServer( + autoReportServer2, + args = list( + registryName = registryName, type = type, + org = shiny::reactive(100082), + paramNames = shiny::reactive(c("organization", "outputFormat")), + paramValues = shiny::reactive(c(999999, "pdf")), + reports = reports, orgs = orgs, user = user + ), + { + session$setInputs(report = "FirstReport") + session$setInputs(freq = "Maanedlig-month") + session$setInputs(start = as.character(Sys.Date())) + session$setInputs(email = "true@email.no") + session$setInputs(addEmail = 1) + session$setInputs(makeAutoReport = 1) + expect_true(origFileSize < file.size( + file.path( + Sys.getenv("R_RAP_CONFIG_PATH"), + "autoReport.yml" + ) + )) + } + ) + }) + + test_that("new subscription can be written to and removed from file", { + origFileSize <- file.size(file.path( + Sys.getenv("R_RAP_CONFIG_PATH"), + "autoReport.yml" + )) + shiny::testServer( + autoReportServer2, + args = list( + registryName = registryName, type = "subscription", + org = shiny::reactive(100082), + reports = reports, orgs = orgs, user = user + ), + { + session$setInputs(report = "FirstReport") + session$setInputs(freq = "Maanedlig-month") + session$setInputs(start = as.character(Sys.Date())) + session$setInputs(makeAutoReport = 1) + expect_true(origFileSize < file.size( + file.path( + Sys.getenv("R_RAP_CONFIG_PATH"), + "autoReport.yml" + ) + )) + # get newly created edit button id (from last entry in table) + # and test it by entry being removed from table + btnRaw <- autoReport$tab[dim(autoReport$tab)[1], ]$Endre + editButton <- rvest::read_html(btnRaw) %>% + rvest::html_element("button") %>% + rvest::html_attr("id") + repsBefore <- dim(autoReport$tab)[1] + session$setInputs(edit_button = editButton) + repsAfter <- dim(autoReport$tab)[1] + expect_true(repsAfter == (repsBefore - 1)) + # then, true deletion (after adding one more time) + session$setInputs(makeAutoReport = 2) + expect_true(repsBefore == dim(autoReport$tab)[1]) + btnRaw <- autoReport$tab[dim(autoReport$tab)[1], ]$Slett + delButton <- rvest::read_html(btnRaw) %>% + rvest::html_element("button") %>% + rvest::html_attr("id") + session$setInputs(del_button = delButton) + repsAfter <- dim(autoReport$tab)[1] + expect_true(repsAfter == (repsBefore - 1)) + } + ) + }) + + test_that("add email button is not created if email is not valid", { + shiny::testServer( + autoReportServer2, + args = list( + registryName = registryName, type = type, + org = shiny::reactive(100082), + reports = reports, orgs = orgs, user = user + ), + { + session$setInputs(email = "invalid@email-format") + expect_true(is.null(output$editEmail)) + session$setInputs(email = "invalid@email-format.o") + expect_true(is.null(output$editEmail)) + session$setInputs(email = "invalid.email-format.on") + expect_true(is.null(output$editEmail)) + } + ) + }) + + test_that("no submit button is provided when module is not eligible", { + shiny::testServer( + autoReportServer2, + args = list( + registryName = registryName, type = "subscription", + reports = reports, orgs = orgs, eligible = FALSE, user = user + ), + { + session$setInputs(email = "valid.email@format.no") + expect_true(is.null(output$makeAutoReport)) + } + ) + }) + + test_that("tabel is replaced by message when no reports listed", { + file.remove(file.path(Sys.getenv("R_RAP_CONFIG_PATH"), "autoReport.yml")) + file.create(file.path(Sys.getenv("R_RAP_CONFIG_PATH"), "autoReport.yml")) + shiny::testServer( + autoReportServer2, + args = list( + registryName = registryName, type = type, + org = shiny::reactive(100082), + reports = reports, orgs = orgs, user = user + ), + { + session$flushReact() + expect_true(dim(autoReport$tab)[1] == 0) + } + ) + }) + } +) + # Restore instance Sys.setenv(R_RAP_CONFIG_PATH = currentConfigPath) diff --git a/tests/testthat/test-moduleNavbarWidget.R b/tests/testthat/test-moduleNavbarWidget.R index cf43bbf9..1ddce65c 100644 --- a/tests/testthat/test-moduleNavbarWidget.R +++ b/tests/testthat/test-moduleNavbarWidget.R @@ -37,6 +37,42 @@ test_that("test app returns an app object", { }) +## new widget for shinyproxy container instances +file.copy( + system.file("extdata/accesstree.json", package = "rapbase"), + Sys.getenv("R_RAP_CONFIG_PATH") +) + +with_envvar( + new = c( + "R_RAP_INSTANCE" = "QAC", + "SHINYPROXY_USERNAME" = "ttesterc", + "SHINYPROXY_USERGROUPS" = "rapbase,rapbase,utils,utils", + "USERORGID" = "[1, 2, 3, 4]", + "USERFULLNAME" = "Tore Tester Container" + ), + code = { + + test_that("shinyproxy-like module navbar widget server returns output", { + shiny::testServer(navbarWidgetServer2, args = list( + orgName = registryName, + caller = "rapbase" + ), { + expect_equal(output$name, "Tore Tester Container") + expect_equal(class(output$affiliation), "character") + session$setInputs(userInfo = 1) + session$setInputs(selectOrganization = 1, unit = 1) + expect_equal(rv$name, "ttesterc") + expect_equal(rv$fullName, "Tore Tester Container") + expect_equal(rv$group, "rapbase") + expect_equal(rv$unit, "1") + expect_equal(rv$org, "100082") + expect_equal(rv$role, "LU") + }) + }) + } +) + # Restore instance Sys.setenv(R_RAP_INSTANCE = currentInstance) Sys.setenv(R_RAP_CONFIG_PATH = currentConfigPath) diff --git a/tests/testthat/test-userInfo.R b/tests/testthat/test-userInfo.R index a192d8ad..be5bb961 100644 --- a/tests/testthat/test-userInfo.R +++ b/tests/testthat/test-userInfo.R @@ -128,6 +128,158 @@ test_that("Function can handle redefined contexts", { ), "999999") }) +# New: container instance for QA and PRODUCTION contexts +Sys.setenv(R_RAP_CONFIG_PATH = tempdir()) +file.copy( + system.file( + c("rapbaseConfig.yml", "extdata/accesstree.json"), package = "rapbase" + ), + Sys.getenv("R_RAP_CONFIG_PATH") +) + + +with_envvar( + new = c( + "SHINYPROXY_USERGROUPS" = "rapbase", + "USERORGID" = "" + ), + code = { + test_that("errors are returned when insufficient system environment", { + expect_error( + userAttribute("rapbase"), + regexp = "Environmental variables SHINYPROXY_USERGROUPS and USERORGID") + }) + } +) + +with_envvar( + new = c( + "SHINYPROXY_USERGROUPS" = "", + "USERORGID" = "1" + ), + code = { + test_that("errors are returned when insufficient system environment", { + expect_error( + userAttribute("rapbase"), + regexp = "Environmental variables SHINYPROXY_USERGROUPS and USERORGID") + }) + } +) + +with_envvar( + new = c( + "SHINYPROXY_USERGROUPS" = "rapbase,utils", + "USERORGID" = "[1]" + ), + code = { + test_that("error is returned when environment elements are not equal", { + expect_error( + userAttribute("rapbase"), + regexp = "Vectors obtained from SHINYPROXY_USERGROUPS and USERORGID") + }) + } +) + +with_envvar( + new = c( + "SHINYPROXY_USERGROUPS" = "rapbase,rapbase,utils,utils", + "USERORGID" = "[1, 2, 3, 4]" + ), + code = { + test_that("group and unit are returned correspondingly when unit = NULL", { + expect_true(class(userAttribute("rapbase")) == "list") + expect_true( + length(userAttribute("rapbase")$group) == + length(userAttribute("rapbase")$unit) + ) + expect_true(length(userAttribute("rapbase")$group) == 2) + expect_true(userAttribute("rapbase")$group[1] == "rapbase") + expect_true(userAttribute("rapbase")$group[2] == "rapbase") + expect_true(userAttribute("rapbase")$unit[1] == "1") + expect_true(userAttribute("rapbase")$unit[2] == "2") + }) + } +) + +with_envvar( + new = c( + "SHINYPROXY_USERGROUPS" = "rapbase,rapbase,utils,utils", + "USERORGID" = "[1, 2, 3, 4]" + ), + code = { + test_that("group and unit returned correspondingly when unit is given", { + expect_true(class(userAttribute("rapbase")) == "list") + expect_true( + length(userAttribute("rapbase", unit = 2)$group) == + length(userAttribute("rapbase", unit = 2)$unit) + ) + expect_true( + userAttribute("rapbase", unit = 2)$unit == 2 + ) + expect_true( + userAttribute("utils", unit = 3)$unit == 3 + ) + }) + } +) + +with_envvar( + new = c( + "SHINYPROXY_USERGROUPS" = "rapbase,rapbase,utils,utils", + "USERORGID" = "[1, 2, 3, 4]" + ), + code = { + test_that("correct lookup values are provided", { + expect_true( + userAttribute("rapbase", unit = 2)$org == 102966 + ) + expect_true( + userAttribute("utils", unit = 3)$role == "SC" + ) + }) + } +) + +## unitAttribute +test_that("error is returned when attributes file does not exist", { + expect_error(unitAttribute(1, "role", file = "does_not_exist.json")) +}) + +test_that("error is returned when unknown attribute", { + expect_error(unitAttribute(1, "userRole")) +}) + +test_that("warning is given when unit does not exist", { + expect_warning(unitAttribute(100000, "role")) +}) + +test_that("unit attributes can be obtained", { + expect_equal(unitAttribute(2, "role"), "SC") +}) + +with_envvar( + new = c( + "R_RAP_INSTANCE" = "QAC", + "SHINYPROXY_USERNAME" = "userc", + "SHINYPROXY_USERGROUPS" = "rapbase", + "USERORGID" = "2", + "USEREMAIL" = "userc@container.no", + "USERFULLNAME" = "User Container", + "USERPHONE" = "+4787654321" + ), + code = { + test_that("User attribs can be fetched in container instance (QA, PROD)", { + expect_equal(getUserName(shinySession, "rapbase"), "userc") + expect_equal(getUserGroups(shinySession, "rapbase"), "rapbase") + expect_equal(getUserReshId(shinySession, "rapbase"), "102966") + expect_equal(getUserRole(shinySession, "rapbase"), "SC") + expect_equal(getUserEmail(shinySession, "rapbase"), "userc@container.no") + expect_equal(getUserFullName(shinySession, "rapbase"), "User Container") + expect_equal(getUserPhone(shinySession, "rapbase"), "+4787654321") + }) + } +) + # Restore instance Sys.setenv(R_RAP_INSTANCE = currentInstance) Sys.setenv(R_RAP_CONFIG_PATH = currentConfigPath)