Shiny-server can't connect to PostgreSQL

Question

I have a shiny dashboard on a Ubuntu server that connects to the 'local' PostgreSQL db to collect data. It works perfectly well when I launch the dashboard from my R-Studio environment (on the same server), but the dashboard fails to load when I access it as a shiny-server dashboard. Every other dashboard works perfectly well, so I know shiny-server is functional. This is the only dashboard that connects to a potgres db though.

I managed to figure out it's the dbConnect function that creates the error. When I comment it out (and everything that depends on it), the dashboard loads (as a skeleton obviously).

When I access the shiny-server dashboard through http://serverIPAddress/dashboardName/ , I get the following error:

ERROR: An error has occurred. Check your logs or contact the app author for clarification.

And this is the log file:

Error in ans[!test & ok] <- rep(no, length.out = length(ans))[!test &: 
  replacement has length zero
Calls: <Anonymous> -> ifelse
In addition: Warning message:
In rep(no, length.out = length(ans)) :
  'x' is NULL so the result will be NULL
Execution halted

My suspicion is that shiny-server can't access the postgres db, even though root can. Has anyone experience this problem before?

Thanks

EDIT: adding parts of my code. It's only the top bits, but you get the idea. The error goes away when I comment out the dbDriver and src_postgres functions

ui.R

library(shiny)
library(dplyr)
library(RPostgreSQL)
library(magrittr)
library(leaflet)
library(tidyr)

drv <- dbDriver("PostgreSQL")
con <- src_postgres(dbname = "sandtonrelocation")

travelEventTransactional <-  tbl(con, "travel_event_transactional")


# for the next two connections, the inner join section is to only     
  select the latest entry

employeeData <- 
  tbl(con, "employee_data") %>% 
  inner_join(tbl(con, "employee_data")  %>% 
               group_by(employee_id) %>% 
               summarise(date_added = max(date_added)),
                 by = c("employee_id", "date_added")) 

employeeAddressData <-  
  tbl(con, "employee_address_data") %>% 
  inner_join(tbl(con, "employee_address_data")  %>% 
               group_by(employee_id) %>% 
               summarise(date_added = max(date_added)),
             by = c("employee_id", "date_added"))  

# UI start ====
shinyUI(fluidPage(

  # title ====
  titlePanel("Sandton relocation impact study"),

  # sidebar ====
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "businessUnitId",
                  label = "Select business unit",
                  choices = c("All", employeeData %>% 
                                select(business_unit) %>%
                                distinct  %>%
                                arrange(business_unit) %>% 
                                collect %$%
                                business_unit),
                  selected = "CPS"),

and so on

server.R

  library(shiny)
  library(dplyr)
  library(RPostgreSQL)
  library(magrittr)
  library(leaflet)
  library(leaflet.extras)
  library(ggplot2)
  library(rlang)

  source('./lib/mulitplot.R')
  source('./lib/compareScenarios.R')
  source('./lib/maritalStatus.R')
  source('./lib/extra_dfs.R')

  ## connect to DB =====
  drv <- dbDriver("PostgreSQL")
  con <- src_postgres(dbname = "sandtonrelocation")
  travelEventTransactional <-  tbl(con, "travel_event_transactional")

  # for the next two connections, the inner join section is to only select the 
  # latest entry
  employeeData <- 
    tbl(con, "employee_data") %>% 
    inner_join(tbl(con, "employee_data")  %>% 
                 group_by(employee_id) %>% 
                 summarise(date_added = max(date_added)),
               by = c("employee_id", "date_added")) 

  employeeAddressData <-  
    tbl(con, "employee_address_data") %>% 
    inner_join(tbl(con, "employee_address_data")  %>% 
                 group_by(employee_id) %>% 
                 summarise(date_added = max(date_added)),
               by = c("employee_id", "date_added"))  

  ## leaflet map object ====
  gautrainIcon <- makeIcon(
    iconUrl = "./images/Gautrain.png",
    iconWidth = 10, iconHeight = 10
  )

  mmiIcon <- makeIcon(
    iconUrl = "./images/Map-Icons-02.png",
    iconWidth = 22.5, iconHeight = 22.5
  )

  m <- 
    leaflet() %>%
    fitBounds(
      lng1 = 27.8,
      lat1 = -26.3,
      lng2 = 28.42,
      lat2 = -25.66
    ) %>%
    addProviderTiles(providers$OpenStreetMap.BlackAndWhite) %>%
    addMarkers(lat = -25.8537801, lng = 28.1919999, 
               labelOptions = labelOptions(noHide = T, textOnly = TRUE,
                                           style = list(color = 'red')),
               icon=mmiIcon) %>%
    addMarkers(lat = -26.10306, lng = 28.060131, 
               labelOptions = labelOptions(noHide = T, textOnly = TRUE,
                                           style = list(color = 'red')),
               icon=mmiIcon)

  ## Shiny server start ====
  shinyServer(function(input, output) {

    # DF deltaTravelReactive ====
    deltaTravelReactive <- reactive({

      travelEventTransactionalScenario <- 
        if(input$selectScenario == "Everyone relocates")  {
          travelEventTransactional %>% collect() %>%  
            filter(work_location %in% c("current", "MARC"))
        } else {
          travelEventTransactional %>% 
            collect() %>% 
            left_join(read.csv(paste("./scenarios/", 
                                     input$selectScenario, 
                                     ".csv", 
                                     sep = "")), 
                      by = c("employee_id" = "Employee.ID"), copy = T) %>%
            mutate(Future.occupancy = ifelse(Future.occupancy == "Sandton", "MARC",
                                             ifelse(Future.occupancy == "Centurion", "Centurion Main Building"))) %>%
            filter((work_location == "current") |
                     work_location == Future.occupancy) %>%
            select(-Future.occupancy) %>%
            ungroup
        }  

      travelEventTransactionalSubset <- 
        travelEventTransactionalScenario %>% 
        left_join(employeeData %>% 
                    select(employee_id, 
                           age, gender, 
                           business_unit, 
                           children, 
                           marital_status,
                           rem_bin), 
                  by = 'employee_id', copy = T) %>% 
        filter(if(input$businessUnitId == "All") {event_id > 0} else {
          business_unit == input$businessUnitId
        }) %$% 
        mutate(., 
               marital_status = sapply(marital_status, 
                                       function(x) mapMaritalStatus(x)),
               children = sapply(children, 
                                 function(x) if(x == T | x > 0) T else F))

      # cheap escape, fix this later on 
      if(length(travelEventTransactionalSubset$work_location %>% unique) == 1) {
        -1
      } else {

        compareScenarios(travelEventTransactionalSubset, 
                         "travel_time_car") %>% 
          left_join(compareScenarios(travelEventTransactionalSubset, 
                                     "travel_cost_car"),
                    by = c("employee_id", "children", "marital_status")) %>% 
          left_join(compareScenarios(travelEventTransactionalSubset, 
                                     "travel_time_gautrain"),
                    by = c("employee_id", "children", "marital_status")) %>% 
          left_join(compareScenarios(travelEventTransactionalSubset, 
                                     "travel_cost_gautrain"),
                    by = c("employee_id", "children", "marital_status")) %>% 
          left_join(employeeData %>% select(employee_id,rem_bin), copy = T,
                    by = "employee_id") %>%
          mutate(current_train_faster = current_travel_time_car > current_travel_time_gautrain &
                   current_travel_time_gautrain != 0,
                 current_train_cheaper = current_travel_cost_car > current_travel_cost_gautrain &
                   current_travel_time_gautrain != 0,
                 future_train_faster = future_travel_time_car > future_travel_time_gautrain &
                   future_travel_time_gautrain != 0,
                 future_train_cheaper = future_travel_cost_car > future_travel_cost_gautrain &
                   future_travel_time_gautrain != 0,
                 delta_cost_car = future_travel_cost_car - current_travel_cost_car,
                 delta_time_car = future_travel_time_car - current_travel_time_car)
      }

    })


    # PLOT deltaDriveTime ====
    output$deltaDriveTime <- renderPlot({

      deltaTravel <- deltaTravelReactive()

      if(deltaTravel == -1) {
        ggplot() +
          geom_text(aes(x = 0, y = 0,
                        label = paste('No change for', input$businessUnitId)), col = 'dodgerblue3', size = 9) +
          theme_minimal() %+replace%
          theme(axis.text = element_blank(),
                axis.title = element_blank())
      } else {

        deltaTravel%>%
          mutate(deltaTimeCar = future_travel_time_car - current_travel_time_car) %>% 
          ggplot() +
          geom_histogram(aes(x = deltaTimeCar), binwidth = input$binSizeTime,
                         fill = 'dodgerblue',col = 'dodgerblue',
                         alpha = .85) +
          stat_bin(aes(x = deltaTimeCar,
                       label = scales::percent(..count../sum(..count..))),
                   geom = 'text', binwidth = input$binSizeTime, size = 3, vjust = -1) +
          theme_minimal() %+replace%
          theme(plot.title = element_text(size = 12),
                axis.title.y = element_blank(),
                axis.text.y = element_blank()) +
          xlab("Time") +
          ggtitle("Increase in travel time after moving to MARC")
      }
    })

Answer 1

Seems like it was an issue with rights. Shiny-server does not connect to psql as root, but as shiny.

All I had to do was add shiny as a role to psql and give it login rights.

create role shiny;
alter user shiny with login;

Problem solved :)