tests/testthat/test-otel-conversion.R

In bidux: Behavioral Insight Design: A Toolkit for Integrating Behavioral Science in UI/UX Design

# ============================================================================
# OTEL SPAN-TO-EVENT CONVERSION TESTS
# ============================================================================
# tests for agent 1's otel span conversion to shiny.telemetry event format
# verifies that otel spans are correctly transformed to bidux-compatible events

test_that("session_start span converts to login event", {
  skip_if_no_otel()

  # create session_start span
  spans <- create_mock_otel_spans(
    sessions = 1,
    reactives_per_session = 0,
    outputs_per_session = 0
  )
  session_span <- spans[spans$name == "session_start", ]

  # convert to events
  events <- bidux:::convert_otel_spans_to_events(session_span)

  # verify conversion
  expect_true(is.data.frame(events))
  expect_gt(nrow(events), 0)

  # verify event_type mapping
  login_events <- events[events$event_type == "login", ]
  expect_gt(nrow(login_events), 0)

  # verify session_id extracted from attributes
  expect_true("session_id" %in% names(events))
  expect_false(any(is.na(events$session_id)))

  # verify timestamp conversion
  expect_true("timestamp" %in% names(events))
  expect_s3_class(events$timestamp, "POSIXct")
})

test_that("session_end span converts correctly", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(
    sessions = 1,
    reactives_per_session = 0,
    outputs_per_session = 0
  )
  end_span <- spans[spans$name == "session_end", ]

  events <- bidux:::convert_otel_spans_to_events(end_span)

  # session_end might map to logout or custom event
  expect_true(is.data.frame(events))
  expect_gt(nrow(events), 0)

  # should have event_type field
  expect_true("event_type" %in% names(events))
})

test_that("output span converts to output event", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(
    sessions = 1,
    reactives_per_session = 0,
    outputs_per_session = 3
  )
  output_spans <- spans[grepl("^output:", spans$name), ]

  expect_gt(nrow(output_spans), 0)

  events <- bidux:::convert_otel_spans_to_events(output_spans)

  # verify output event creation
  output_events <- events[events$event_type == "output", ]
  expect_gt(nrow(output_events), 0)

  # verify output_id extraction from span name
  expect_true("output_id" %in% names(events))

  # output_id should match the name after "output:"
  first_output_name <- output_spans$name[1]
  expected_id <- sub("^output:", "", first_output_name)
  expect_true(expected_id %in% events$output_id)
})

test_that("output span calculates duration_ms correctly", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(
    sessions = 1,
    reactives_per_session = 0,
    outputs_per_session = 2
  )
  output_spans <- spans[grepl("^output:", spans$name), ]

  events <- bidux:::convert_otel_spans_to_events(output_spans)

  # verify duration calculation
  expect_true(
    "duration_ms" %in% names(events) || "render_time" %in% names(events)
  )

  # duration should be positive
  if ("duration_ms" %in% names(events)) {
    expect_true(all(events$duration_ms > 0, na.rm = TRUE))
  }

  # duration should be reasonable (< 10 seconds for most renders)
  if ("duration_ms" %in% names(events)) {
    expect_true(all(events$duration_ms < 10000, na.rm = TRUE))
  }
})

test_that("reactive span converts to input event", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(
    sessions = 1,
    reactives_per_session = 5,
    outputs_per_session = 0
  )
  reactive_spans <- spans[spans$name == "reactive", ]

  expect_gt(nrow(reactive_spans), 0)

  events <- bidux:::convert_otel_spans_to_events(reactive_spans)

  # reactive might map to input or reactive event type
  expect_true(is.data.frame(events))
  expect_gt(nrow(events), 0)

  # should have input_id or reactive_id
  has_id <- "input_id" %in% names(events) || "reactive_id" %in% names(events)
  expect_true(has_id)
})

test_that("reactive span extracts input_id from attributes", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(
    sessions = 1,
    reactives_per_session = 3,
    outputs_per_session = 0
  )
  reactive_spans <- spans[spans$name == "reactive", ]

  events <- bidux:::convert_otel_spans_to_events(reactive_spans)

  # input_id should be extracted from span attributes
  if ("input_id" %in% names(events)) {
    # should have non-NA values
    has_values <- any(!is.na(events$input_id))
    expect_true(has_values)
  }
})

test_that("error span events convert to error events", {
  skip_if_no_otel()

  # create spans with errors
  spans <- create_mock_otel_spans(
    sessions = 2,
    outputs_per_session = 10,
    include_errors = TRUE
  )

  events <- bidux:::convert_otel_spans_to_events(spans)

  # should have error events
  error_events <- events[events$event_type == "error", ]

  # with 2 sessions, 10 outputs each, 10% error rate, expect some errors
  expect_gt(nrow(error_events), 0)

  # error events should have error_message
  expect_true("error_message" %in% names(error_events))
  expect_false(all(is.na(error_events$error_message)))
})

test_that("error message extraction from span events", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(
    sessions = 1,
    outputs_per_session = 10,
    include_errors = TRUE
  )

  events <- bidux:::convert_otel_spans_to_events(spans)
  error_events <- events[events$event_type == "error", ]

  if (nrow(error_events) > 0) {
    # error messages should be strings
    expect_type(error_events$error_message, "character")

    # should have actual content
    has_content <- any(nchar(error_events$error_message) > 0, na.rm = TRUE)
    expect_true(has_content)
  }
})

test_that("span attributes extracted correctly", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(sessions = 1, reactives_per_session = 3)

  events <- bidux:::convert_otel_spans_to_events(spans)

  # test session.id -> session_id mapping
  expect_true("session_id" %in% names(events))
  expect_false(any(is.na(events$session_id)))

  # all events should have same session_id (from same session)
  expect_equal(length(unique(events$session_id)), 1)
})

test_that("span attribute key mappings are correct", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(sessions = 1)

  events <- bidux:::convert_otel_spans_to_events(spans)

  # verify common attribute mappings
  # session.id -> session_id
  # output.name -> output_id
  # reactive.label -> input_id
  # navigation.target -> navigation_id

  expected_fields <- c("session_id", "event_type", "timestamp")
  expect_true(all(expected_fields %in% names(events)))
})

test_that("span timestamps parsed correctly from unix nano", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(sessions = 1, reactives_per_session = 2)

  events <- bidux:::convert_otel_spans_to_events(spans)

  # timestamps should be POSIXct
  expect_s3_class(events$timestamp, "POSIXct")

  # timestamps should be recent (within last day)
  expect_true(all(events$timestamp > Sys.time() - 86400))

  # timestamps should be ordered
  expect_true(all(diff(as.numeric(events$timestamp)) >= 0))
})

test_that("unix nanosecond to POSIXct conversion is accurate", {
  skip_if_no_otel()

  # create span with known timestamp
  test_time <- as.POSIXct("2025-01-01 12:00:00", tz = "UTC")
  test_nano <- format(as.numeric(test_time) * 1e9, scientific = FALSE)

  test_span <- tibble::tibble(
    traceId = "test123",
    spanId = "span001",
    parentSpanId = NA_character_,
    name = "session_start",
    startTimeUnixNano = test_nano,
    endTimeUnixNano = as.character(as.numeric(test_nano) + 1e9),
    attributes = list(list(list(
      list(key = "session.id", value = list(stringValue = "s1"))
    ))),
    events = list(list(list()))
  )

  events <- bidux:::convert_otel_spans_to_events(test_span)

  # converted timestamp should match original
  expect_equal(
    as.numeric(events$timestamp[1]),
    as.numeric(test_time),
    tolerance = 1
  )
})

test_that("span timestamp timezone handling", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(sessions = 1)

  events <- bidux:::convert_otel_spans_to_events(spans)

  # timestamps should have timezone attribute
  expect_true(!is.null(attr(events$timestamp, "tzone")))

  # should be UTC or local timezone
  tz <- attr(events$timestamp, "tzone")
  expect_true(tz %in% c("UTC", "", Sys.timezone()))
})

test_that("span duration calculated correctly from nano timestamps", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(sessions = 1, outputs_per_session = 5)

  events <- bidux:::convert_otel_spans_to_events(spans)

  # duration_ms = (endTime - startTime) / 1e6
  if ("duration_ms" %in% names(events)) {
    # all durations should be positive
    expect_true(all(events$duration_ms > 0, na.rm = TRUE))

    # durations should be reasonable (< 5 seconds for most operations)
    expect_true(median(events$duration_ms, na.rm = TRUE) < 5000)
  }
})

test_that("duration has millisecond precision", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(sessions = 1, outputs_per_session = 3)

  events <- bidux:::convert_otel_spans_to_events(spans)

  if ("duration_ms" %in% names(events)) {
    # should have sub-second precision (not all integers)
    has_decimal <- any((events$duration_ms %% 1) != 0, na.rm = TRUE)

    # note: may not always have decimals in mock data, so soft check
    expect_true(is.numeric(events$duration_ms))
  }
})

test_that("missing session.id attribute handled gracefully", {
  skip_if_no_otel()

  # create span without session.id attribute
  span_no_session <- tibble::tibble(
    trace_id = "test123",
    span_id = "span001",
    parent_span_id = NA_character_,
    name = "test",
    startTimeUnixNano = "1609459200000000000",
    endTimeUnixNano = "1609459200100000000",
    attributes = list(list(list())), # empty attributes
    events = list(list(list()))
  )

  # should not error, but produce NA for session_id
  expect_no_error({
    events <- bidux:::convert_otel_spans_to_events(span_no_session)
  })

  # session_id should be NA, not missing
  expect_true("session_id" %in% names(events))
})

test_that("missing input_id attribute handled gracefully", {
  skip_if_no_otel()

  # create reactive span without input_id
  span_no_input <- tibble::tibble(
    trace_id = "test123",
    span_id = "span001",
    parent_span_id = NA_character_,
    name = "reactive",
    startTimeUnixNano = "1609459200000000000",
    endTimeUnixNano = "1609459200100000000",
    attributes = list(list(list(
      list(key = "session.id", value = list(stringValue = "s1"))
    ))),
    events = list(list(list()))
  )

  expect_no_error({
    events <- bidux:::convert_otel_spans_to_events(span_no_input)
  })

  # input_id may be NA
  if ("input_id" %in% names(events)) {
    expect_true(is.character(events$input_id) || is.na(events$input_id))
  }
})

test_that("navigation span converts correctly", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(sessions = 3, reactives_per_session = 2)
  nav_spans <- spans[spans$name == "navigation", ]

  if (nrow(nav_spans) > 0) {
    events <- bidux:::convert_otel_spans_to_events(nav_spans)

    # should create navigation events
    expect_true(
      "navigation" %in% events$event_type || "nav" %in% events$event_type
    )

    # should have navigation_id
    expect_true("navigation_id" %in% names(events) || "page" %in% names(events))
  }
})

test_that("navigation_id extracted from attributes", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(sessions = 5, reactives_per_session = 2)
  nav_spans <- spans[spans$name == "navigation", ]

  if (nrow(nav_spans) > 0) {
    events <- bidux:::convert_otel_spans_to_events(nav_spans)

    if ("navigation_id" %in% names(events)) {
      # should have values
      expect_false(all(is.na(events$navigation_id)))
    }
  }
})

test_that("span parent-child hierarchy preserved", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(sessions = 1, reactives_per_session = 3)

  events <- bidux:::convert_otel_spans_to_events(spans)

  # if parent_span_id is preserved, check it
  if ("parent_span_id" %in% names(events)) {
    # child spans should reference parent
    has_parents <- any(!is.na(events$parent_span_id))
    expect_true(has_parents)
  }
})

test_that("trace_id preserved for correlation", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(sessions = 2, reactives_per_session = 3)

  events <- bidux:::convert_otel_spans_to_events(spans)

  # trace_id helps correlate events from same trace
  if ("trace_id" %in% names(events)) {
    # should have 2 unique trace_ids (one per session)
    expect_equal(length(unique(events$trace_id)), 2)
  }
})

test_that("conversion handles all shiny span types", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(
    sessions = 2,
    reactives_per_session = 5,
    outputs_per_session = 3
  )

  events <- bidux:::convert_otel_spans_to_events(spans)

  # should have multiple event types
  event_types <- unique(events$event_type)

  # expect session events
  expect_true(any(c("login", "session_start") %in% event_types))

  # expect output events
  expect_true("output" %in% event_types)
})

test_that("observe spans convert correctly", {
  skip_if_no_otel()

  # create custom span with observe type
  observe_span <- tibble::tibble(
    trace_id = "test123",
    span_id = "span001",
    parent_span_id = NA_character_,
    name = "observe",
    startTimeUnixNano = "1609459200000000000",
    endTimeUnixNano = "1609459200100000000",
    attributes = list(list(list(
      list(key = "session.id", value = list(stringValue = "s1")),
      list(key = "observer.label", value = list(stringValue = "data_loader"))
    ))),
    events = list(list(list()))
  )

  expect_no_error({
    events <- bidux:::convert_otel_spans_to_events(observe_span)
  })

  # should create some event
  expect_gt(nrow(events), 0)
})

test_that("reactive debounce and throttle spans handled", {
  skip_if_no_otel()

  # create debounce span
  debounce_span <- tibble::tibble(
    trace_id = "test123",
    span_id = "span001",
    parent_span_id = NA_character_,
    name = "reactive debounce",
    startTimeUnixNano = "1609459200000000000",
    endTimeUnixNano = "1609459200100000000",
    attributes = list(list(list(
      list(key = "session.id", value = list(stringValue = "s1"))
    ))),
    events = list(list(list()))
  )

  expect_no_error({
    events <- bidux:::convert_otel_spans_to_events(debounce_span)
  })

  expect_true(is.data.frame(events))
})

test_that("ExtendedTask spans convert correctly", {
  skip_if_no_otel()

  task_span <- tibble::tibble(
    traceId = "test123",
    spanId = "span001",
    parentSpanId = NA_character_,
    name = "reactive:long_computation",
    startTimeUnixNano = "1609459200000000000",
    endTimeUnixNano = "1609459205000000000", # 5 seconds
    attributes = list(list(list(
      list(key = "session.id", value = list(stringValue = "s1")),
      list(key = "input_id", value = list(stringValue = "long_computation"))
    ))),
    events = list(list(list()))
  )

  expect_no_error({
    events <- bidux:::convert_otel_spans_to_events(task_span)
  })

  # duration should reflect long-running task
  if ("duration_ms" %in% names(events)) {
    expect_gt(events$duration_ms[1], 1000) # > 1 second
  }
})

test_that("conversion preserves all required shiny.telemetry fields", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(
    sessions = 1,
    reactives_per_session = 3,
    outputs_per_session = 2
  )

  events <- bidux:::convert_otel_spans_to_events(spans)

  # required fields for compatibility
  required_fields <- c("timestamp", "session_id", "event_type")

  expect_true(all(required_fields %in% names(events)))

  # no NA values in required fields
  expect_false(any(is.na(events$timestamp)))
  expect_false(any(is.na(events$session_id)))
  expect_false(any(is.na(events$event_type)))
})

test_that("conversion handles empty spans input", {
  skip_if_no_otel()

  empty_spans <- tibble::tibble(
    trace_id = character(0),
    span_id = character(0),
    parent_span_id = character(0),
    name = character(0),
    startTimeUnixNano = character(0),
    endTimeUnixNano = character(0),
    attributes = list(),
    events = list()
  )

  result <- bidux:::convert_otel_spans_to_events(empty_spans)

  # should return empty but valid dataframe
  expect_true(is.data.frame(result))
  expect_equal(nrow(result), 0)
})

test_that("conversion handles malformed span attributes", {
  skip_if_no_otel()

  bad_span <- tibble::tibble(
    trace_id = "test123",
    span_id = "span001",
    parent_span_id = NA_character_,
    name = "test",
    startTimeUnixNano = "1609459200000000000",
    endTimeUnixNano = "1609459200100000000",
    attributes = list(list("not_a_valid_structure")),
    events = list(list(list()))
  )

  # should handle gracefully, not crash
  expect_no_error({
    events <- bidux:::convert_otel_spans_to_events(bad_span)
  })
})

test_that("conversion handles span events with missing attributes", {
  skip_if_no_otel()

  span_with_bad_event <- tibble::tibble(
    trace_id = "test123",
    span_id = "span001",
    parent_span_id = NA_character_,
    name = "output:test",
    startTimeUnixNano = "1609459200000000000",
    endTimeUnixNano = "1609459200100000000",
    attributes = list(list(list(
      list(key = "session.id", value = list(stringValue = "s1"))
    ))),
    events = list(list(list(
      list(name = "exception", attributes = list()) # no error message
    )))
  )

  expect_no_error({
    events <- bidux:::convert_otel_spans_to_events(span_with_bad_event)
  })
})

test_that("large span batch conversion is efficient", {
  skip_if_no_otel()
  skip_on_cran() # performance test with larger dataset

  # create large dataset
  large_spans <- create_mock_otel_spans(
    sessions = 50,
    reactives_per_session = 20,
    outputs_per_session = 10
  )

  # should complete quickly
  start_time <- Sys.time()
  events <- bidux:::convert_otel_spans_to_events(large_spans)
  elapsed <- as.numeric(difftime(Sys.time(), start_time, units = "secs"))

  expect_lt(elapsed, 5) # should complete in < 5 seconds
  expect_gt(nrow(events), 100)
})

test_that("conversion maintains event order by timestamp", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(sessions = 2, reactives_per_session = 10)

  events <- bidux:::convert_otel_spans_to_events(spans)

  # events should be ordered by timestamp
  timestamps <- as.numeric(events$timestamp)
  expect_true(all(diff(timestamps) >= 0))
})

test_that("conversion de-duplicates identical spans", {
  skip_if_no_otel()

  spans <- create_mock_otel_spans(sessions = 1, reactives_per_session = 2)

  # duplicate the spans
  duplicated_spans <- rbind(spans, spans)

  events <- bidux:::convert_otel_spans_to_events(duplicated_spans)

  # should not double-count events (if de-duplication implemented)
  # or should handle gracefully
  expect_true(is.data.frame(events))
})

# ============================================================================
# extract_span_attribute BRANCH COVERAGE TESTS
# ============================================================================

test_that("extract_span_attribute returns NA for NULL or empty input", {
  # null input

  result_null <- bidux:::extract_span_attribute(NULL, c("key1"))
  expect_equal(result_null, NA_character_)

  # empty list
  result_empty <- bidux:::extract_span_attribute(list(), c("key1"))
  expect_equal(result_empty, NA_character_)

  # zero-length vector
  result_zero <- bidux:::extract_span_attribute(character(0), c("key1"))
  expect_equal(result_zero, NA_character_)
})

test_that("extract_span_attribute handles data.frame with direct column names", {
  # data.frame where the key is a column name with a value in it
  attrs_df <- data.frame(
    session.id = "sess_001",
    input_id = "slider1",
    stringsAsFactors = FALSE
  )

  result <- bidux:::extract_span_attribute(attrs_df, c("session.id"))
  expect_equal(result, "sess_001")

  result2 <- bidux:::extract_span_attribute(attrs_df, c("input_id"))
  expect_equal(result2, "slider1")

  # key not found
  result_missing <- bidux:::extract_span_attribute(attrs_df, c("nonexistent"))
  expect_equal(result_missing, NA_character_)
})

test_that("extract_span_attribute handles data.frame with key/value columns", {
  # data.frame in key/value format (e.g., from sqlite attribute tables)
  attrs_kv <- data.frame(
    key = c("session.id", "input_id", "output_id"),
    value = c("sess_002", "slider1", "plot1"),
    stringsAsFactors = FALSE
  )

  result <- bidux:::extract_span_attribute(attrs_kv, c("session.id"))
  expect_equal(result, "sess_002")

  result2 <- bidux:::extract_span_attribute(
    attrs_kv,
    c("input_id", "widget_id")
  )
  expect_equal(result2, "slider1")

  # key not found in key/value columns
  result_missing <- bidux:::extract_span_attribute(attrs_kv, c("nonexistent"))
  expect_equal(result_missing, NA_character_)
})

test_that("extract_span_attribute handles named list", {
  # named list (simple key=value pairs)
  attrs_named <- list(
    session.id = "sess_003",
    input_id = "text_input"
  )

  result <- bidux:::extract_span_attribute(attrs_named, c("session.id"))
  expect_equal(result, "sess_003")

  result2 <- bidux:::extract_span_attribute(attrs_named, c("input_id"))
  expect_equal(result2, "text_input")

  # key not present
  result_missing <- bidux:::extract_span_attribute(attrs_named, c("missing"))
  expect_equal(result_missing, NA_character_)
})

test_that("extract_span_attribute handles list-of-objects with stringValue", {
  # otlp-style list of {key, value: {stringValue: ...}} objects
  attrs_otlp <- list(
    list(key = "session.id", value = list(stringValue = "sess_004")),
    list(key = "input_id", value = list(stringValue = "dropdown1"))
  )

  result <- bidux:::extract_span_attribute(attrs_otlp, c("session.id"))
  expect_equal(result, "sess_004")

  result2 <- bidux:::extract_span_attribute(attrs_otlp, c("input_id"))
  expect_equal(result2, "dropdown1")
})

test_that("extract_span_attribute handles list-of-objects with intValue fallback", {
  # otlp-style attribute with intValue instead of stringValue
  attrs_int <- list(
    list(key = "http.status_code", value = list(intValue = 200)),
    list(key = "request.size", value = list(intValue = 1024))
  )

  result <- bidux:::extract_span_attribute(attrs_int, c("http.status_code"))
  expect_equal(result, "200")

  result2 <- bidux:::extract_span_attribute(attrs_int, c("request.size"))
  expect_equal(result2, "1024")
})

test_that("extract_span_attribute handles list-of-objects with plain value", {
  # otlp-style attribute with plain value (no stringValue/intValue wrapper)
  attrs_plain <- list(
    list(key = "custom.attr", value = "plain_value")
  )

  result <- bidux:::extract_span_attribute(attrs_plain, c("custom.attr"))
  expect_equal(result, "plain_value")
})

test_that("extract_span_attribute tries multiple key names in order", {
  # should find first matching key from the provided vector
  attrs <- list(
    list(key = "widget_id", value = list(stringValue = "found_widget"))
  )

  # "input_id" not present but "widget_id" is the second candidate
  result <- bidux:::extract_span_attribute(attrs, c("input_id", "widget_id"))
  expect_equal(result, "found_widget")
})

test_that("extract_span_attribute skips NA values in data.frame columns", {
  # data.frame where the matched column has NA
  attrs_na <- data.frame(
    session.id = NA_character_,
    stringsAsFactors = FALSE
  )

  result <- bidux:::extract_span_attribute(attrs_na, c("session.id"))
  expect_equal(result, NA_character_)
})