inst/shiny-apps/abm/server.R

In KTH-Library/bibliomatrix: Provide Functionality for Bibliometric Analytics

library(shiny)
library(shinydashboard)
library(shinythemes)
library(bibliomatrix)
library(dplyr)
library(purrr)
library(ktheme)

# deploy to shiny in root context
#ln -s /usr/local/lib/R/site-library/bibliomatrix/shiny-apps/abm/* .

# for test purposes
# NB cache location will vary dep on loading with Ctrl-Shift-L or not
# TODO config below could be a fcn

#Sys.setenv("ABM_IS_PUBLIC" = "TRUE")
#Sys.setenv("ABM_IS_PUBLIC" = "")

ABM_IS_PUBLIC <- ifelse(Sys.getenv("ABM_IS_PUBLIC") != "", TRUE, FALSE)
#Sys.setenv("ABM_API" = "")

ABM_URL_PUBLIC <- ifelse(Sys.getenv("ABM_URL_PUBLIC") != "", Sys.getenv("ABM_URL_PUBLIC"), "https://kth.se/abm/public")
ABM_URL_PRIVATE <- ifelse(Sys.getenv("ABM_URL_PRIVATE") != "", Sys.getenv("ABM_URL_PRIVATE"), "https://www.kth.se/abm/app_direct/abm/")

ABM_API <- Sys.getenv("ABM_API")

if (ABM_API == "") 
    ABM_API <- "http://localhost:8080"

ABM_API_UNIT <- ifelse(ABM_IS_PUBLIC, 
   paste0(ABM_API, "/unit/%s/flexdashboard"),
   paste0(ABM_API, "/unit/%s/flexdashboard?embeddata=true")
)

ABM_API_EMP <- paste0(ABM_API, "/employee/%s/flexdashboard")

server <- function(input, output, session) {

  kthid <- function() {
    if (!ABM_IS_PUBLIC) {
      ua <- Sys.getenv("SHINYPROXY_USERNAME")
      if (ua == "") ua <- "u1u0kle4@kth.se"
      re_saml <- "(.*)@kth\\.se$"
      is_saml <- function(x) stringr::str_detect(x, re_saml)
      parse_id <- function(x) stringr::str_match(x, re_saml)[,2]
      
      jwt <- Sys.getenv("SHINYPROXY_OIDC_ACCESS_TOKEN")
      if (jwt != "") {
        payload <- abm_decode_jwt(jwt)
        kthid <- payload$kthid
        kthid <- setNames(kthid, sprintf("%s (%s)", payload$unique_name[1], payload$username))
        #setNames(kthid, displayname_from_kthid(kthid))
        return (kthid)
      }
      
      if (is_saml(ua)) {
        kthid <- parse_id(ua)
        kthid <- setNames(kthid, displayname_from_kthid(kthid))
      } else {
        # if shinyproxy with saml then we get user identity as kthid@kth.se
        # if shinyproxy with ldap then we get user identity as LDAP accountname
        message("Not shinyproxy/shiny and not SAML, warning... appears to use LDAP")
        kthid <- setNames(kthid, displayname_from_kthid(kthid))
      }
    } else {
      kthid <- NULL
    }
    
    return (kthid)
  }
  
  default_org_id <- function(kthid){
    # Set selected org to KTH for now.
    return(177)
  }
  
  output$units <- renderUI({
    
    orgs <- abm_public_kth$meta$Diva_org_id %>% 
      set_names(abm_public_kth$meta$unit_long_en_indent2)
    
    if (!ABM_IS_PUBLIC)
      orgs <- c(kthid(), orgs)
    
    shiny::selectInput(inputId = "unitid", label = tags$span(style = paste("color:", kth_colors("darkblue")), "Select unit"), 
                       choices = orgs, selected = 1, #default_org_id(kthid()),
                       multiple = FALSE, selectize = TRUE, width = "100%")
  })
  
  dash_src <- function(id) {
    if (id %in% abm_public_kth$meta$Diva_org_id)
      return (sprintf(ABM_API_UNIT, id))
    if (id == kthid())
      return (sprintf(ABM_API_EMP, id))
  }
  
  is_employee <- function(id) id == kthid()
  
  output$switcher <- renderMenu(
    sidebarMenu(
      menuItem(text = if_else(ABM_IS_PUBLIC,
                              "Log in to view your own data",
                              "Switch to public app"),
               href = if_else(ABM_IS_PUBLIC, ABM_URL_PRIVATE, ABM_URL_PUBLIC),
               icon = icon(if_else(ABM_IS_PUBLIC, "sign-in", "sign-out"))
      )
    )
  )               
  
  
  # output$login <- renderUI({
  #     if (!ABM_IS_PUBLIC) {
  #         out <- tags$li(class = "dropdown", 
  #             style = "padding-top:7px; padding-bottom:7px;",
  #             tags$li(class = "dropdown", 
  #                 tags$a(href = ABM_URL_PUBLIC,
  #                    class = "button button-primary button-sm",
  #                    "Switch to public app", icon("sign-out"), " ... ",
  #                    title = "Switch to the public version of this application")
  #             )
  #         )
  #     } else if (ABM_IS_PUBLIC == TRUE) {
  #         out <- tags$li(class = "dropdown", 
  #             style = "padding-top:7px; padding-bottom:7px;",
  #             tags$li(class = "dropdown", 
  #                 tags$a(href = ABM_URL_PRIVATE, 
  #                        style = "padding:7px;",
  #                     class = "button button-primary button-sm",
  #                     "Use your KTH account", icon("sign-in"), " ... ", img(src = "KTH_logo_RGB_bla.png", height = 30, width = 30),
  #                     title = "Switch to view your own publications if you are a KTH researcher")
  #             )
  #         )            
  #     } else {
  #         out <- ""
  #     }
  #     
  #     out
  # })
  
  output$frame <- renderUI({
    
    req(input$unitid)
    
    cat("Report for:", input$unitid, "private visibility:", !ABM_IS_PUBLIC, "\n")
    
    report <- abm_report(id = input$unitid, is_private = !ABM_IS_PUBLIC)
    is_ok <- !is.null(report)
    
    if (is_ok) {    
      
      #tags$div(HTML(rawToChar(report)))  # this causes CSS issues w navbar
      #b64 <- base64enc::dataURI(data = report, mime = "text/html")  # this causes slow enc
      
      # NB: permission issue if not writing to cache dir (has o+wr)
      tf <- paste0(file.path("cache", openssl::sha1(rawToChar(report))), ".html")
      readr::write_file(report, paste0("www/", tf))
      
      htmltools::tags$iframe(src = tf, 
                             frameborder = 0, scrolling = "auto", height="100%", width="100%")
      
    } else {
      paste("No report available for this unit, please contact the system owner.")
    }
    
    
  })    
  
}