R/tracking.R

In karimelghazouly/shinylogs_modified: Record Everything that Happens in a 'Shiny' Application

#' @title Insert dependencies to track usage of a Shiny app
#'
#' @description If used in \code{ui} of an application,
#'  this will create new \code{input}s available in the server.
#'  Set \code{dependencies = FALSE} in \code{\link{track_usage}}
#'  server-side to load dependencies only once.
#'
#' @param on_unload Logical, save log when user close the browser window or tab,
#'  if \code{TRUE} it prevent to create \code{shinylogs}
#'  input during normal use of the application, there will
#'  be created only on close, downside is that a popup will appear asking to close the page.
#' @param exclude_input_regex Regular expression to exclude inputs from tracking.
#' @param exclude_input_id Vector of \code{inputId} to exclude from tracking.
#'
#' @note The following \code{input}s will be accessible in the server:
#'
#'   - \strong{.shinylogs_lastInput} : last \code{input} used by the user
#'
#'   - \strong{.shinylogs_input} : all \code{input}s send from the browser to the server
#'
#'   - \strong{.shinylogs_error} : all errors generated by \code{output}s elements
#'
#'   - \strong{.shinylogs_output} : all \code{output}s generated from the server
#'
#'   - \strong{.shinylogs_browserData} : information about the browser where application is displayed.
#'
#' @export
#'
#' @importFrom htmltools attachDependencies tags singleton
#' @importFrom jsonlite toJSON
#' @importFrom bit64 as.integer64
#' @importFrom nanotime nanotime
#' @importFrom digest digest
#'
#' @example examples/use_tracking.R
use_tracking <- function(on_unload = FALSE, exclude_input_regex = NULL, exclude_input_id = NULL) {
  app_name <- basename(getwd())
  timestamp <- Sys.time()
  init_log <- data.frame(
    app = app_name,
    server_connected = get_timestamp(timestamp),
    stringsAsFactors = FALSE
  )
  timestamp <- format(as.integer64(nanotime(timestamp)), scientific = FALSE)
  init_log$sessionid <- digest::digest(timestamp)
  tag_log <- tags$script(
    id = "shinylogs-tracking",
    type = "application/json",
    `data-for` = "shinylogs",
    toJSON(dropNulls(list(
      logsonunload = isTRUE(on_unload),
      exclude_input_regex = exclude_input_regex,
      exclude_input_id = exclude_input_id,
      sessionid = init_log$sessionid
    )), auto_unbox = TRUE, json_verbatim = TRUE)
  )
  attachDependencies(
    x = singleton(tag_log),
    value = list(
      localforage_dependencies(),
      dayjs_dependencies(),
      shinylogs_lf_dependencies()
    )
  )
}



#' @importFrom stats setNames
parse_logInput <- function(x, shinysession, name) {
  lapply(
    X = x,
    FUN = function(x) {
      setNames(x, NULL)
    }
  )
}

#' @importFrom anytime anytime
parse_lastInput <- function(x, shinysession, name) {
  if (!is.null(x)) {
    x$timestamp <- anytime(x$timestamp)
  }
  return(x)
}


#' @title Track usage of a Shiny app
#'
#' @description Used in Shiny \code{server} it will record all inputs and
#'  output changes and errors that occurs through an output.
#'
#' @param storage_mode Storage mode to use : \code{\link{store_json}}, \code{\link{store_rds}},
#'  \code{\link{store_sqlite}} or \code{\link{store_null}}.
#' @param exclude_input_regex Regular expression to exclude inputs from tracking.
#' @param exclude_input_id Vector of \code{inputId} to exclude from tracking.
#' @param on_unload Logical, save log when user close the browser window or tab,
#'  if \code{TRUE} it prevent to create \code{shinylogs}
#'  input during normal use of the application, there will
#'  be created only on close, downside is that a popup will appear asking to close the page.
#' @param exclude_users Character vectors of user for whom it is not necessary to save the log.
#' @param get_user A \code{function} to get user name, it should
#'  return a character and take one argument: the Shiny session.
#' @param dependencies Load dependencies.
#' @param session The shiny session.
#'
#' @export
#'
#' @note The following \code{input}s will be accessible in the server:
#'
#'   - \strong{.shinylogs_lastInput} : last \code{input} used by the user
#'
#'   - \strong{.shinylogs_input} : all \code{input}s send from the browser to the server
#'
#'   - \strong{.shinylogs_error} : all errors generated by \code{output}s elements
#'
#'   - \strong{.shinylogs_output} : all \code{output}s generated from the server
#'
#'   - \strong{.shinylogs_browserData} : information about the browser where application is displayed.
#'
#' @importFrom shiny getDefaultReactiveDomain insertUI onSessionEnded isolate observe
#' @importFrom nanotime nanotime
#' @importFrom bit64 as.integer64
#' @importFrom digest digest
#' @importFrom jsonlite toJSON
#' @importFrom htmltools tags singleton
#'
#' @example examples/track_usage-json.R
#' @example examples/track_usage-console.R
track_usage <- function(storage_mode,
                        session_id,
                        exclude_input_regex = NULL,
                        exclude_input_id = NULL,
                        on_unload = FALSE,
                        exclude_users = NULL,
                        get_user = NULL,
                        dependencies = TRUE,
                        session = getDefaultReactiveDomain()) {

  stopifnot(inherits(storage_mode, "shinylogs.storage_mode"))

  app_name <- basename(getwd())
  if (is.null(get_user))
    get_user <- get_user_
  if (!is.function(get_user))
    stop("get_user must be a function", call. = FALSE)
  user <- get_user(session)
  timestamp <- Sys.time()
  init_log <- data.frame(
    app = app_name,
    user = user,
    server_connected = get_timestamp(timestamp),
    stringsAsFactors = FALSE
  )
  storage_mode$appname <- app_name
  storage_mode$timestamp <- format(as.integer64(nanotime(timestamp)), scientific = FALSE)
  init_log$sessionid <- session_id

  if (isTRUE(dependencies)) {
    insertUI(
      selector = "body", where = "afterBegin",
      ui = singleton(tags$script(
        id = "shinylogs-tracking",
        type = "application/json",
        `data-for` = "shinylogs",
        toJSON(dropNulls(list(
          logsonunload = isTRUE(on_unload),
          exclude_input_regex = exclude_input_regex,
          exclude_input_id = exclude_input_id,
          sessionid = init_log$sessionid
        )), auto_unbox = TRUE, json_verbatim = TRUE)
      )),
      immediate = TRUE,
      session = session
    )
    insertUI(
      selector = "body", where = "afterBegin",
      ui = attachDependencies(
        x = tags$div(),
        value = list(
          localforage_dependencies(),
          dayjs_dependencies(),
          shinylogs_lf_dependencies()
        )
      ),
      immediate = FALSE,
      session = session
    )
  }


  if (isTRUE(storage_mode$console)) {
    observe({
      to_console(session$input$.shinylogs_browserData, init_log)
    })
    observe({
      to_console(session$input$.shinylogs_lastInput)
    })
  }


  onSessionEnded(
    fun = function() {
      init_log$server_disconnected <- get_timestamp(Sys.time())
      logs <- c(isolate(session$input$.shinylogs_input),
                isolate(session$input$.shinylogs_error),
                isolate(session$input$.shinylogs_output))
      browser_data <- isolate(session$input$.shinylogs_browserData)
      if (!is.null(browser_data)) {
        browser_data <- as.data.frame(browser_data)
        logs$session <- cbind(init_log, browser_data)
      } else {
        logs$session <- init_log
      }
      if (isTRUE(!user %in% exclude_users)) {
        # write_logs(storage_mode, logs, init_log$sessionid)
        send_logs_to_datadog(logs, init_log$sessionid)
      }
    },
    session = session
  )
}

#' @importFrom jsonlite toJSON
send_logs_to_datadog <- function(logs, session_id){
  json_logs = toJSON(
    logs
  )
  print(json_logs)
}

get_user_ <- function(session) {
  if (!is.null(session$user))
    return(session$user)
  user <- Sys.getenv("SHINYPROXY_USERNAME")
  if (user != "") {
    return(user)
  } else {
    getOption("shinylogs.default_user", default = Sys.info()[['user']])
  }
}


#' @importFrom jsonlite toJSON
to_console <- function(obj, ...) {
  if (!is.null(obj)) {
    json <- jsonlite::toJSON(
      x = c(obj, ...),
      pretty = TRUE, auto_unbox = TRUE
    )
    print(json)
  }
}