tests/testthat/test-telemetry.R

In Appsilon/shiny.stats: 'Shiny' App Usage Telemetry

test_that("Telemetry tests with mock data_storage layer", {
  data_storage <- list(
    insert = function(
      app_name, type, session = NULL, details = NULL, time = NULL
    ) {
      message(glue::glue(
        "Writing type={type} value: ",
        "{jsonlite::toJSON(details, auto_unbox = TRUE)}"
      ))
    },
    event_bucket = "event_log"
  )

  telemetry <- Telemetry$new(data_storage = data_storage)

  # Mock ShinySession (with required class added to pass assertions)
  session <- shiny::MockShinySession$new()
  class(session) <- c("ShinySession", class(session))

  # Inputs are changed via session to best mimick that behaviour
  session$setInputs(sample = 53, sample2 = 31)

  # 'log_input' uses 'observeEvent' internally, thus the function needs to be
  # mocked. This cannot be done with 'mockery::stub()' as this function
  # cannot scope the private methods of a class.
  # `testthat::local_mocked_bindings` allows for it.
  testthat::local_mocked_bindings(
    observeEvent = function(
      eventExpr, handlerExpr, ... # nolint object_name.
    ) {
      shiny::isolate(handlerExpr)
    },
    .package = "shiny"
  )

  #
  # Test login and logout (last one shouldn't produce anything)

  telemetry$log_login(
    username = "ben",
    session = session
  ) %>% expect_message("Writing type=login value: .*\"username\":\"ben\".*")

  telemetry$log_logout(
    session = session
  ) %>% expect_silent()

  #
  # Test simple usage of log_input
  session$setInputs(sample = 53, sample2 = 31)

  telemetry$log_input(
    input_id = "sample",
    matching_values = NULL,
    track_value = TRUE,
    input_type = "text",
    session = session
  ) %>% expect_message("Writing type=input value: .*\"value\":53.*")

  #
  # Test simple usage of log_input with matching values that don't match
  session$setInputs(sample = 63, sample2 = 41)

  telemetry$log_input(
    "sample",
    track_value = TRUE,
    matching_values = c(62, "62"),
    input_type = "text",
    session = session
  ) %>% expect_silent()

  #
  # Test simple usage of log_input with matching values
  session$setInputs(sample = 73, sample2 = 51)

  telemetry$log_input(
    "sample",
    track_value = TRUE,
    matching_values = 73,
    input_type = "text",
    session = session
  ) %>% expect_message("Writing type=input value: .*\"value\":73.*")

  #
  # Test simple usage of log_input without tracking values
  session$setInputs(sample = 83, sample2 = 61)
  telemetry$log_input(
    "sample",
    matching_values = NULL,
    input_type = "text",
    session = session
  ) %>% expect_message("Writing type=input value: .*\"id\":\"sample\".*")

  #
  # Test simple usage of log_input without tracking values
  # (where value is not atomic)
  session$setInputs(sample = 1:10, sample2 = 31)
  telemetry$log_input(
    "sample",
    matching_values = NULL,
    input_type = "text",
    session = session
  ) %>% expect_message("Writing type=input value: .*\"id\":\"sample\".*")

  #
  # Test simple usage of log_input (where value is not atomic)
  session$setInputs(sample = list(1, 2, 3), sample2 = 31)
  telemetry$log_input(
    "sample",
    track_value = TRUE,
    matching_values = NULL,
    input_type = "text",
    session = session
  ) %>%
    expect_message("Writing type=input value: .*\"id\":\"sample_1\".*") %>%
    expect_message("Writing type=input value: .*\"id\":\"sample_2\".*") %>%
    expect_message("Writing type=input value: .*\"id\":\"sample_3\".*")

  #
  # Test simple usage of log_input
  session$setInputs(uisidebar = "tab1")
  telemetry$log_navigation(
    input_id = "uisidebar",
    session = session
  ) %>%
    expect_message("Writing type=navigation value: .*\"value\":\"tab1\".*")

  telemetry$log_navigation_manual(
    navigation_id = "sample",
    value = "tab2",
    session = session
  ) %>%
    expect_message("Writing type=navigation value: .*\"value\":\"tab2\".*")

  # Manual call to revert mock_binding of 'observeEvent'
  withr::deferred_run()
})