diff --git a/R/moduleNavbarWidget.R b/R/moduleNavbarWidget.R index b39a7c77..a83e0e32 100644 --- a/R/moduleNavbarWidget.R +++ b/R/moduleNavbarWidget.R @@ -108,16 +108,22 @@ navbarWidgetServer <- function(id, orgName, #' @rdname navbarWidget +#' @param map_orgname A data.frame containing two columns: +#' \describe{ +#' \item{UnitId}{unit ids} +#' \item{orgname}{corresponding organization names} +#' } #' @export navbarWidgetServer2 <- function( id, orgName, + map_orgname = NULL, caller = environmentName(topenv(parent.frame())) ) { shiny::moduleServer(id, function(input, output, session) { - user <- userAttribute() + user <- userAttribute(map_orgname = map_orgname) stopifnot(length(user$name) > 0) # Initial privileges and affiliation will be first in list diff --git a/R/userAttribute.R b/R/userAttribute.R index 3ac34d4e..b2968975 100644 --- a/R/userAttribute.R +++ b/R/userAttribute.R @@ -156,7 +156,8 @@ userInfo <- function( } } - switch(entity, + switch( + entity, user = user, groups = groups, resh_id = resh_id, @@ -180,6 +181,11 @@ userInfo <- function( #' 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. +#' @param map_orgname A data.frame containing two columns: +#' \describe{ +#' \item{UnitId}{unit ids} +#' \item{orgname}{corresponding organization names} +#' } #' #' @return Invisibly a list of user metadata and privileges: #' \describe{ @@ -194,7 +200,8 @@ userInfo <- function( #' } #' @export -userAttribute <- function(unit = NULL) { +userAttribute <- function(unit = NULL, + map_orgname = NULL) { if (Sys.getenv("FALK_EXTENDED_USER_RIGHTS") == "" || Sys.getenv("FALK_APP_ID") == "") { @@ -222,29 +229,11 @@ userAttribute <- function(unit = NULL) { orgs <- tilganger$U roles <- tilganger$R - # nolint start - # if (Sys.getenv("http_proxy") == "") { - # f <- file.path(Sys.getenv("R_RAP_CONFIG_PATH"), "rapbaseConfig.yml") - # if (file.exists(f)) { - # proxy <- yaml::yaml.load_file(f)$network$proxy$http - # Sys.setenv(http_proxy = proxy) - # Sys.setenv(https_proxy = proxy) - # } - # } - # proxy <- file.path(Sys.getenv("R_RAP_CONFIG_PATH"), "rapbaseConfig.yml")$ - #tilgangstre_url <- Sys.getenv("ACCESSTREE_URL") - #httr::set_config(httr::config(ssl_verifypeer = 0L)) - #tilgangstre <- httr::GET(tilgangstre_url) - #tilgangstre <- httr::content(tilgangstre, as="text") - # HACK I PÅVENTE AV PROXYINNSTILLINGER - tilgangstre <- "{\"AccessUnits\":[{\"UnitId\":0,\"ParentUnitId\":null,\"HasDatabase\":true,\"ExternalId\":\"0\",\"HealthUnitId\":null,\"Title\":\"Nasjonal instans\",\"TitleWithPath\":\"Nasjonal instans\",\"ValidFrom\":null,\"ValidTo\":null,\"ExtraData\":null},{\"UnitId\":100083,\"ParentUnitId\":0,\"HasDatabase\":true,\"ExternalId\":\"100083\",\"HealthUnitId\":null,\"Title\":\"Helse Stavanger HF\",\"TitleWithPath\":\"Helse Stavanger HF\",\"ValidFrom\":null,\"ValidTo\":null,\"ExtraData\":null},{\"UnitId\":102212,\"ParentUnitId\":null,\"HasDatabase\":true,\"ExternalId\":\"102212\",\"HealthUnitId\":null,\"Title\":\"Helse Midt-Norge IT\",\"TitleWithPath\":\"Helse Midt-Norge IT\",\"ValidFrom\":null,\"ValidTo\":null,\"ExtraData\":null},{\"UnitId\":104919,\"ParentUnitId\":null,\"HasDatabase\":true,\"ExternalId\":\"104919\",\"HealthUnitId\":null,\"Title\":\"Helse Vest IKT\",\"TitleWithPath\":\"Helse Vest IKT\",\"ValidFrom\":null,\"ValidTo\":null,\"ExtraData\":null},{\"UnitId\":105403,\"ParentUnitId\":100083,\"HasDatabase\":false,\"ExternalId\":\"105403\",\"HealthUnitId\":null,\"Title\":\"Ortopedisk avdeling\",\"TitleWithPath\":\"Helse Stavanger HF/Ortopedisk avdeling\",\"ValidFrom\":null,\"ValidTo\":null,\"ExtraData\":null}]}" - # tilgangstreyaml <- yaml::read_yaml( - # paste0(Sys.getenv("R_RAP_CONFIG_PATH"), "/accesstree.yaml")) - # tilgangstrejson <- tilgangstreyaml$data$accesstree.json - # tilgangstre <- jsonlite::fromJSON(tilgangstrejson, flatten = FALSE)[[1]] - # nolint end - tilgangstre <- jsonlite::fromJSON(tilgangstre, flatten = FALSE)[[1]] - orgNames <- tilgangstre$TitleWithPath[match(orgs, tilgangstre$UnitId)] + if (!is.null(map_orgname)) { + orgNames <- map_orgname$orgname[match(orgs, map_orgname$UnitId)] + } else { + orgNames <- rep("Ukjent", length(units)) + } name <- Sys.getenv("SHINYPROXY_USERNAME") fullName <- parse(text = paste0( @@ -255,14 +244,6 @@ userAttribute <- function(unit = NULL) { phone <- Sys.getenv("FALK_USER_PHONE") email <- Sys.getenv("FALK_USER_EMAIL") - # Look up org, role and unit name - # nolint start - # orgNames <- vector() - # for (i in seq_len(length(units))) { - # orgNames[i] <- rapbase::unitAttribute(tilganger$U[i], "titlewithpath") - # } - # nolint end - list( name = rep(name, length(units)), fullName = rep(fullName, length(units)), diff --git a/man/navbarWidget.Rd b/man/navbarWidget.Rd index a48c8539..9b6ad612 100644 --- a/man/navbarWidget.Rd +++ b/man/navbarWidget.Rd @@ -15,6 +15,7 @@ navbarWidgetServer(id, orgName, caller = environmentName(rlang::caller_env())) navbarWidgetServer2( id, orgName, + map_orgname = NULL, caller = environmentName(topenv(parent.frame())) ) @@ -38,6 +39,12 @@ 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.} + +\item{map_orgname}{A data.frame containing two columns: +\describe{ + \item{UnitId}{unit ids} + \item{orgname}{corresponding organization names} + }} } \value{ Shiny objects, mostly. \code{navbarWidgetServer2()} invisibly returns diff --git a/man/userAttribute.Rd b/man/userAttribute.Rd index dda8e332..2313d920 100644 --- a/man/userAttribute.Rd +++ b/man/userAttribute.Rd @@ -11,7 +11,7 @@ \alias{getUserRole} \title{User attributes in container apps running behind shinyproxy} \usage{ -userAttribute(unit = NULL) +userAttribute(unit = NULL, map_orgname = NULL) getUserEmail(shinySession = NULL, group = NULL) @@ -31,6 +31,12 @@ getUserRole(shinySession = NULL, group = NULL) \item{unit}{Integer providing the look-up unit id. Default value is NULL in which case all privileges for \code{group} are returned.} +\item{map_orgname}{A data.frame containing two columns: +\describe{ + \item{UnitId}{unit ids} + \item{orgname}{corresponding organization names} + }} + \item{shinySession}{A shiny session object. Default value is NULL} \item{group}{Character string providing the name of the app R package name.