R/app_server.R

In mcanigueral/testapp: A Shiny app test using {golem}

#' The application server-side
#' 
#' @param input,output,session Internal parameters for {shiny}. 
#'     DO NOT REMOVE.
#' @import shiny
#' @importFrom dplyr filter select mutate rename
#' @importFrom lubridate as_datetime dmy force_tz floor_date days now month
#' @importFrom tidyr fill
#' @importFrom dygraphs dygraph renderDygraph
#' @importFrom mongolite mongo
#' @importFrom rlang .data
#' @importFrom golem get_golem_options
#' @importFrom httr GET config oauth_app oauth_endpoints oauth2.0_token oauth2.0_access_token
#' 
#' @noRd
app_server <- function( input, output, session ) {
  

# Configure this study case -----------------------------------------------
  
  glob <- readRDS('inst/app/global.rds')
  
  conf <- glob$server_conf
  auth_conf <- glob$auth$conf
  auth_app <- glob$auth$app
  
  # Check if user is authenticated. If not, return nothing.
  auth_params <- parseQueryString(isolate(session$clientData$url_search))
  if (is.null(auth_params$code)) {
    return()
  }
  
  # If user is authenticated get the token to check if its email is allowed
  auth_token <- httr::oauth2.0_token(
    endpoint = auth_conf$endpoint, app = auth_app, cache = FALSE,
    credentials = httr::oauth2.0_access_token(
      endpoint = auth_conf$endpoint, app = auth_app,
      redirect_uri = auth_conf$redirect_uri, code = auth_params$code
    )
  )
  
  infouser <- content(httr::GET(
    "https://www.googleapis.com/oauth2/v1/userinfo",
    httr::config(token = auth_token)
  ))
  
  # If user is not allowed return the Rejection UI
  if (!(infouser$email %in% auth_conf$users)) {
    return(output$ui <- renderUI(ui_not_allowed()))
  }
  
  
#######################################################################
# Reaching this point means that user has been authenticated correctly  
#######################################################################
  
  output$ui <- renderUI(dashboardPage_ui())
  
# Server-side application ----------------------------------------------
  
  # Get study case data
  intro_html <- paste(readLines("inst/app/www/intro.html", encoding = "UTF-8"), collapse = "\n")
  horizon_1 <- read_excel("inst/app/data/1.xlsx")
  

  # Global variables --------------------------------------------------------
  
  # Time sequence
  
  tzone <- conf$timezone
  seq_2018 <- force_tz(seq.POSIXt(from = as_datetime(dmy("01012018")), length.out = 8760, by = "hour"), tzone = tzone)
  seq_2018[which(is.na(seq_2018))] <- seq_2018[which(is.na(seq_2018)) - 1]
  
  # Modules
  dateRange <- callModule(mod_dateRange_server, "dateRange_selector")
  
  # MongoDB configuration
  ehpc_con <- mongolite::mongo("smappee", url = conf$mongo$uri)
  start <- (now()-days(7)) %>% floor_date(unit = "days") %>% as.integer()
  query <- sprintf('{"timestamp" : { "$gte" : %s } }', start)
  

  # Body elements -----------------------------------------------------------
  
  # Introduction
  
  output$introduction <- renderUI(HTML(intro_html))
  
  
  # Local files

  output$solar_plot <- renderDygraph({
    testapp::solar_data %>% 
      filter(month(.data$datetime) >= dateRange$start, month(.data$datetime) <= dateRange$end) %>% 
      df_to_ts() %>% 
      dygraph()
  })
  
  
  # Database files
  
  output$mongo_plot <- renderDygraph({
    mongo_df <- ehpc_con$find(query) %>%
      mutate(
        datetime = as_datetime(.data$timestamp, tz = tzone),
        consumption = .data$consumption / 1000,
        production = .data$solar / 1000
      ) %>%
      group_by(.data$datetime) %>% 
      summarise(
        consumption = sum(.data$consumption),
        production = sum(.data$production)
      )
    
    mongo_df %>% 
      filter(month(.data$datetime) >= dateRange$start, month(.data$datetime) <= dateRange$end) %>% 
      df_to_ts() %>% 
      dygraph()
  })
  
  
  # Cloud files
  
  output$horizon_plot <- renderDygraph({
    horizon_1 %>%
      filter(month(.data$datetime) >= dateRange$start, month(.data$datetime) <= dateRange$end) %>%
      df_to_ts() %>%
      dygraph()
  })
  

}