Merge branch 'main' into default_db

Rapporteket · Jan 17, 2025 · b2dd13d · b2dd13d
2 parents aceccd7 + 9748641
commit b2dd13d
Show file tree

Hide file tree

Showing 11 changed files with 77 additions and 72 deletions.
diff --git a/R/log.R b/R/log.R
@@ -356,13 +356,16 @@ createLogDbTabs <- function() {
 #' @param name Character string with registry filter. Default value is an empty
 #' string that will return all log entries. If not empty its value must
 #' correspond to an existing registry (\emph{i.e.} R package) name.
+#' @param app_id An identifier for a particular registry. Default value is NULL,
+#' in which case no action is taken. If value is provided, the log is filtered
+#' to show only entries matching chosen app_id.
 #'
 #' @return A data frame of log entries
 #' @keywords internal
-readLog <- function(type, name = "") {
+readLog <- function(type, name = "", app_id = NULL) {
   stopifnot(type == "report" | type == "app")
 
-  config <- getConfig(fileName = "rapbaseConfig.yml")
+  config <- rapbase::getConfig(fileName = "rapbaseConfig.yml")
   target <- config$r$raplog$target
 
   if (target == "file") {
@@ -393,11 +396,11 @@ readLog <- function(type, name = "") {
     }
   } else if (target == "db") {
     query <- paste0("SELECT * FROM ", type, "Log")
-    if (name != "") {
-      paste0(query, " WHERE group = ", name)
-    }
     query <- paste0(query, ";")
-    log <- loadRegData(config$r$raplog$key, query)
+    log <- rapbase::loadRegData(config$r$raplog$key, query)
+    if (!is.null(app_id)) {
+      log <- log[which(log$group == app_id), ]
+    }
     log <- log %>%
       dplyr::select(-"id")
   } else {

diff --git 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/moduleStats.R b/R/moduleStats.R
@@ -10,6 +10,9 @@
 #'
 #' @param id Character string shiny module id
 #' @param registryName Character string registry name key
+#' @param app_id An identifier for a particular registry. Default value is NULL,
+#' in which case no action is taken. If value is provided, the log is filtered
+#' to show only entries matching chosen app_id.
 #' @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.
@@ -78,10 +81,13 @@ statsUI <- function(id) {
 
 #' @rdname stats
 #' @export
-statsServer <- function(id, registryName, eligible = TRUE) {
+statsServer <- function(id,
+                        registryName,
+                        app_id = NULL,
+                        eligible = TRUE) {
   shiny::moduleServer(id, function(input, output, session) {
     log <- shiny::reactive({
-      readLog(input$type, registryName) %>%
+      readLog(input$type, registryName, app_id) %>%
         logFormat()
     })
 

diff --git 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/inst/exportGuide.Rmd b/inst/exportGuide.Rmd
@@ -4,10 +4,6 @@ params:
 title: '`r paste0("Veiledning for eksport av ", params$registryName, "-data")`'
 ---
 
-```{r dbName, echo=FALSE}
-dbName <- rapbase::getConfig()[[params$registryName]]$name
-```
-
 ## Eksport av `r params$registryName`-databasen
 Her kan statistikere som jobber med Rapporteket laste ned hele databasen. Formatet som benyttes gjør det enkelt å sette opp en egen database for analyse- og utviklingsformål. Nedlastet fil er kryptert og innholdet er utilgjengelig for alle andre enn definert mottaker. Filen slik den lastes ned kan derfor trygt transporteres og eksponeres offentlig uten fare for at innholdet (registerdata) blir tilgjengelig for andre.
 

diff --git a/inst/statsGuide.Rmd b/inst/statsGuide.Rmd
@@ -4,10 +4,6 @@ params:
 title: '`r paste0("Bruksstatistikk for ", params$registryName)`'
 ---
 
-```{r dbName, echo=FALSE}
-dbName <- rapbase::getConfig()[[params$registryName]]$name
-```
-
 ## Innledning
 Her kan du se på og hente ut informasjon om hvordan Rapporteket for `r params$registryName` brukes. I korte trekk vil det si _hvem_, _hva_ og _når_. Formålet med verktøyet er å kunne gi registeransvarlige informasjon som kan brukes til endring og forbedring av eget innhold på Rapporteket. Videre kan informasjonen også benyttes som del av registerets revisjon av tilganger (til registerdata), men det forutsetter at underliggende registrering av bruk har tatt høyde for slik anvendelse av bruksdata.
 

diff --git a/man/navbarWidget.Rd b/man/navbarWidget.Rd
diff --git a/man/readLog.Rd b/man/readLog.Rd
diff --git a/man/stats.Rd b/man/stats.Rd
diff --git a/man/userAttribute.Rd b/man/userAttribute.Rd
diff --git a/tests/testthat/test-userInfo.R b/tests/testthat/test-userInfo.R
@@ -186,15 +186,7 @@ withr::with_envvar(
       expect_true(userAttribute()$unit[1] == "1")
       expect_true(userAttribute()$unit[2] == "2")
     })
-  }
-)
 
-withr::with_envvar(
-  new = c(
-    "FALK_EXTENDED_USER_RIGHTS" = "[{\"A\":80,\"R\":\"LC\",\"U\":1},{\"A\":80,\"R\":\"SC\",\"U\":2},{\"A\":81,\"R\":\"LC\",\"U\":2}]",
-    "FALK_APP_ID" = "80"
-  ),
-  code = {
     test_that("group and unit returned correspondingly when unit is given", {
       expect_equal(class(userAttribute()), "list")
       expect_equal(
@@ -206,24 +198,28 @@ withr::with_envvar(
       )
       expect_equal(userAttribute(unit = 3)$unit, integer(0))
     })
-  }
-)
 
-withr::with_envvar(
-  new = c(
-    "FALK_EXTENDED_USER_RIGHTS" = "[{\"A\":80,\"R\":\"LC\",\"U\":1},{\"A\":80,\"R\":\"SC\",\"U\":2},{\"A\":81,\"R\":\"LC\",\"U\":2}]",
-    "FALK_APP_ID" = "80"
-  ),
-  code = {
     test_that("correct lookup values are provided", {
       expect_equal(
-        userAttribute(unit = 2)$org, 2
+        length(userAttribute(unit = 2)$group),
+        length(userAttribute(unit = 2)$unit)
+      )
+      expect_equal(
+        userAttribute(unit = 2)$unit, 2
+      )
+      expect_equal(userAttribute(unit = 3)$unit, integer(0))
+    })
+
+    test_that("orgname-mapping is working", {
+      maporg <- data.frame(orgname = c("qwerty", "asdfgh"), UnitId = c(1, 2))
+      expect_equal(
+        userAttribute(unit = 2)$orgName, "Ukjent"
       )
       expect_equal(
-        userAttribute(unit = 2)$role, "SC"
+        userAttribute(unit = 2, map_orgname = maporg)$orgName, "asdfgh"
       )
       expect_equal(
-        userAttribute(unit = 1)$role, "LC"
+        userAttribute(unit = 1, map_orgname = maporg)$orgName, "qwerty"
       )
     })
   }