R/contacts.R

In renejuan/DERTtools: Collection of utilities to support DERT work

#' Read state epidemiologists contact list using API or cache
#'
#' This function is a wrapper and internally uses \code{pull_epis_from_cste}. If
#' a cache file exist, it will use the cache file. However, if it does not exist
#' or the \code{force} argument is used then the data will be pulled from
#' \url{https://resources.cste.org/envhealth}.

#' Cache is checked using \code{Sys.date} therefore by default it will only be
#' read directly from the website if the server detect a new date as calculated
#' by \code{Sys.date()}. This cache is used to avoid unnecessary requests.
#'
#' @param force logical; TRUE will force the function to request the data from
#'   the CSTE website.
#'
#' @return
#' A list that include a dataframe and the status for the HTTP POST request.
#'
#' @keywords npds_notifications
#'
#' @export
get_epis <- function(force = FALSE) {

  dir <- "cache"
  filename <- paste0(Sys.Date(), "_CSTE_Epidemiologist.Rds")
  path <- file.path(dir, filename)

  if (file.exists(path) & isFALSE(force)) {
    message("Cache file exist. Reading data from cache.")
    readRDS(path)
  } else {
    message("Cache file is not being used. Reading data from CSTE website and saving to cache file.")
    dir.create(dir)
    results <- pull_epis_from_cste()
    saveRDS(results, file = path)
    results
  }
}

#' Pull state epidemiologists contact list from API
#'
#' \code{pull_epis_from_cste()} pulls state epidemiologist contact list from
#' CSTE website. This contact list is used as the official list where NPDS
#' anomaly notifications are sent.
#'
#' @returns
#' A list that include a dataframe and the status for the HTTP POST request.
#'
#' @noRd
pull_epis_from_cste <- function() {

  url <- "https://resources.cste.org/envhealth"
  ua <- "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/91.0.4472.124 Safari/537.36"

  post_result <- httr::POST("https://resources.cste.org/StateEpi/Grid/MainDetails", httr::user_agent(ua))

  http_status <- httr::http_status(post_result)
  http_type <- httr::http_type(post_result)

  if(http_status[["category"]]=="Success" & http_type=="application/json") {
    content <- httr::content(post_result, as = "text")

    epis_json <- jsonlite::fromJSON(content)

    state_epis <- epis_json$Data

    state_epis <- dplyr::rename(
      state_epis,
      "state" = "State",
      "name" = "StateEpi1",
      "title" = "Title",
      "email" = "Email"
    )

    # Remove leading or trailing spaces
    state_epis <- as.data.frame(apply(state_epis, 2, trimws))

    # Add time stamp
    state_epis$date_updated <- Sys.Date()

    # Remove the ID variable
    state_epis <- subset(state_epis, select = -ID)

  } else {
    state_epis <- NULL
  }

  # Create list and save to file
  list(state_epis = state_epis, http_status = http_status)

}

#' Compare two data sources
#'
#' This function compare two dataframe and returns information about their
#' differences. This function can be used to compare data from an internal
#' source and an externa source. For example, the state epidemiologist contact
#' list from the internal database and the external (CSTE website) database can be
#' compared.
#'
#' This function can be used in combination with bs4Badge to provide a status of
#' the system.
#'
#' @param internal dataframe; dataframe from the internal database.
#' @param external dataframe; dataframe from the external database.
#'
#' @return
#' list that include `res` (TRUE if both data sources are the same or FALSE if
#' they are different). It also includes `color` which can be used within
#' `bs4Dash::bs4Badge` to set the color of the badge. `text` that can be used as
#' a label for the badge. Finally, it includes `changes` which describe the
#' differences (as provided by `setdiff`) between the data sources.
#'
#' @keywords npds_notifications
#'
#' @export

compare_sources <- function(internal, external) {

  # internal_database <- readxl::read_excel(internal, sheet = "state_epis")
  internal_database <- subset(internal, select = -c(date_updated))

  # external_database <- get_epis()[["state_epis"]]
  external_database <- subset(external, select = -c(date_updated))

  int_not_in_ext <- dplyr::setdiff(internal_database, external_database)
  ext_not_in_int <- dplyr::setdiff(external_database, internal_database)

  if(nrow(int_not_in_ext) > 0 | nrow(ext_not_in_int) > 0) {
    res <- FALSE
    color <- "danger"
    text <- "CSTE: Out of sync"
    changes <- list(int_not_in_ext = int_not_in_ext, ext_not_in_int = ext_not_in_int)
  }

  if(nrow(int_not_in_ext) == 0 & nrow(ext_not_in_int) == 0) {
    res <- TRUE
    color <- "success"
    text <- "CSTE: In sync"
    changes <- NULL
  }

  list(res = res, color = color, text = text, changes = changes)

}