R/tracking.R

In shinylogs: Record Everything that Happens in a 'Shiny' Application

#' @title Insert dependencies to track usage of a Shiny app
#'
#' @description If used in UI of an application,
#'  this will create new `input`s available in the server.
#'  Set `dependencies = FALSE` in [track_usage()]
#'  server-side to load dependencies only once.
#' 
#' @param what Elements to record between `"session"`, `"input"`, `"output"` and `"error"`.
#' @param exclude_input_regex Regular expression to exclude inputs from tracking.
#' @param exclude_input_id Vector of `inputId` to exclude from tracking.
#' @param on_unload Logical, save log when user close the browser window or tab,
#'  if `TRUE` it prevent to create `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 app_name Name of the app as a character string.
#'  If `NULL`, `basename(getwd())` (name of the folder where application is located) is used.
#' 
#' @note The following `input`s will be accessible in the server (according to what is used in `record` argument):
#'
#'   - **.shinylogs_lastInput** : last `input` used by the user
#'
#'   - **.shinylogs_input** : all `input`s send from the browser to the server
#'
#'   - **.shinylogs_error** : all errors generated by `output`s elements
#'
#'   - **.shinylogs_output** : all `output`s generated from the server
#'
#'   - **.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(what = c("session", "input", "output", "error"),
                         exclude_input_regex = NULL, 
                         exclude_input_id = NULL,
                         on_unload = FALSE, 
                         app_name = NULL) {
  what <- match.arg(what, several.ok = TRUE)
  if (is.null(app_name)) 
    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(
      what = what,
      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(
      shinylogs_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 : [store_json()], [store_rds()],
#'  [store_sqlite()] or [store_null()].
#' @inheritParams use_tracking
#' @param exclude_users Character vectors of user for whom it is not necessary to save the log.
#' @param get_user A `function` to get user name, it should
#'  return a character and take one argument: the Shiny session.
#' @param dependencies Load dependencies in client, can be set to `FALSE` if [use_tracking()] has been called in UI.
#' @param session The shiny session.
#'
#' @export
#'
#' @note The following `input`s will be accessible in the server:
#'
#'   - **.shinylogs_lastInput** : last `input` used by the user
#'
#'   - **.shinylogs_input** : all `input`s send from the browser to the server
#'
#'   - **.shinylogs_error** : all errors generated by `output`s elements
#'
#'   - **.shinylogs_output** : all `output`s generated from the server
#'
#'   - **.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,
                        what = c("session", "input", "output", "error"),
                        exclude_input_regex = NULL,
                        exclude_input_id = NULL,
                        on_unload = FALSE,
                        app_name = NULL,
                        exclude_users = NULL,
                        get_user = NULL,
                        dependencies = TRUE,
                        session = getDefaultReactiveDomain()) {
  stopifnot(inherits(storage_mode, "shinylogs.storage_mode"))
  what <- match.arg(what, several.ok = TRUE)
  if (is.null(app_name))
    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 <- digest::digest(storage_mode$timestamp)

  if (isTRUE(dependencies)) {
    insertUI(
      selector = "body", where = "afterBegin",
      ui = singleton(tags$script(
        id = "shinylogs-tracking",
        type = "application/json",
        `data-for` = "shinylogs",
        toJSON(dropNulls(list(
          what = what,
          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(
          shinylogs_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)
      }
    },
    session = session
  )
}