# Tests for otel-session.R functions # Helper function to create a mock domain with request info create_mock_session_domain <- function( token = "test-session-123", request = list(), session_ended_callbacks = list() ) { TestMockShinySession <- R6::R6Class( "TestMockShinySession", inherit = MockShinySession, portable = FALSE, lock_objects = FALSE, public = list( # Mock onSessionEnded to capture the callback onSessionEnded = function(callback) { expect_true(is.function(callback)) self$cleanup_callbacks <- c(self$cleanup_callbacks, list(callback)) }, cleanup_callbacks = NULL, request_val = NULL ), active = list( request = function(value) { if (!missing(value)) { self$request_val <- value } else { self$request_val } } ) ) domain <- TestMockShinySession$new() domain$request <- request domain$token <- token domain } test_that("otel_span_session_start returns early when otel not enabled", { domain <- create_mock_session_domain() test_value <- "initial" # Mock has_otel_collect to return FALSE withr::local_options(list(shiny.otel.collect = "none")) result <- otel_span_session_start({ test_value <- "modified" "result_value" }, domain = domain) expect_equal(result, "result_value") expect_equal(test_value, "modified") # Should not have registered any callbacks expect_length(domain$cleanup_callbacks, 0) }) test_that("otel_span_session_start sets up session end callback", { domain <- create_mock_session_domain( token = "session-456", request = list(PATH_INFO = "/app", HTTP_HOST = "localhost") ) test_value <- "initial" # Mock dependencies withr::local_options(list(shiny.otel.collect = "session")) local_mocked_bindings( as_attributes = function(x) x, .package = "otel" ) with_mocked_bindings( has_otel_collect = function(level) level == "session", otel_session_id_attrs = function(domain) list(session.id = domain$token), otel_session_attrs = function(domain) list(PATH_INFO = "/app"), with_otel_span = function(name, expr, attributes = NULL) { expect_equal(name, "session_start") expect_true("session.id" %in% names(attributes)) expect_equal(attributes[["session.id"]], "session-456") force(expr) }, { expect_length(domain$cleanup_callbacks, 0) result <- otel_span_session_start({ test_value <- "modified" "result_value" }, domain = domain) expect_equal(result, "result_value") expect_equal(test_value, "modified") expect_length(domain$cleanup_callbacks, 0) } ) }) test_that("otel_span_session_end returns early when otel not enabled", { domain <- create_mock_session_domain() test_value <- "initial" # Mock has_otel_collect to return FALSE withr::local_options(list(shiny.otel.collect = "none")) result <- otel_span_session_end({ test_value <- "modified" "result_value" }, domain = domain) expect_equal(result, "result_value") expect_equal(test_value, "modified") }) test_that("otel_span_session_end creates span when enabled", { domain <- create_mock_session_domain(token = "session-end-test") span_created <- FALSE test_value <- "initial" # Mock dependencies withr::local_options(list(shiny.otel.collect = "session")) with_mocked_bindings( has_otel_collect = function(level) level == "session", otel_session_id_attrs = function(domain) list(session.id = domain$token), with_otel_span = function(name, expr, attributes = NULL) { span_created <<- TRUE expect_equal(name, "session_end") expect_equal(attributes[["session.id"]], "session-end-test") force(expr) }, { result <- otel_span_session_end({ test_value <- "modified" "result_value" }, domain = domain) expect_equal(result, "result_value") expect_equal(test_value, "modified") expect_true(span_created) } ) }) test_that("otel_session_attrs extracts request attributes correctly", { # Test with full request info domain <- create_mock_session_domain( request = list( PATH_INFO = "/myapp/page", HTTP_HOST = "example.com", HTTP_ORIGIN = "https://example.com", SERVER_PORT = "8080" ) ) attrs <- otel_session_attrs(domain) expect_equal(attrs$server.path, "/myapp/page") expect_equal(attrs$server.address, "example.com") expect_equal(attrs$server.origin, "https://example.com") expect_equal(attrs$server.port, 8080L) # Should be converted to integer }) test_that("otel_session_attrs handles websocket PATH_INFO", { domain <- create_mock_session_domain( request = list( PATH_INFO = "/myapp/websocket/", HTTP_HOST = "localhost" ) ) attrs <- otel_session_attrs(domain) # Should strip websocket suffix expect_equal(attrs$server.path, "/myapp/") }) test_that("otel_session_attrs handles missing request fields", { # Test with minimal request info domain <- create_mock_session_domain( request = list( HTTP_HOST = "localhost" ) ) attrs <- otel_session_attrs(domain) expect_equal(attrs$server.path, "") expect_equal(attrs$server.address, "localhost") expect_equal(attrs$server.origin, "") expect_equal(attrs$server.port, NA_integer_) }) test_that("otel_session_attrs handles empty request", { domain <- create_mock_session_domain(request = list()) attrs <- otel_session_attrs(domain) expect_equal(attrs$server.path, "") expect_equal(attrs$server.address, "") expect_equal(attrs$server.origin, "") expect_equal(attrs$server.port, NA_integer_) }) test_that("otel_session_attrs handles invalid SERVER_PORT gracefully", { domain <- create_mock_session_domain( request = list(SERVER_PORT = "invalid") ) # Should not error even with invalid port attrs <- otel_session_attrs(domain) # Should remain as string if conversion fails expect_equal(attrs$server.port, "invalid") }) test_that("otel_session_id_attrs returns correct session ID", { domain <- create_mock_session_domain(token = "unique-session-token") attrs <- otel_session_id_attrs(domain) expect_equal(attrs$session.id, "unique-session-token") expect_length(attrs, 1) }) test_that("otel_session_id_attrs handles missing token", { domain <- create_mock_session_domain(token = NULL) attrs <- otel_session_id_attrs(domain) expect_null(attrs$session.id) }) test_that("integration test - session start with full request", { domain <- create_mock_session_domain( token = "integration-test-session", request = list( PATH_INFO = "/dashboard/", HTTP_HOST = "shiny.example.com", HTTP_ORIGIN = "https://shiny.example.com", SERVER_PORT = "3838" ) ) session_callback <- NULL span_attributes <- NULL # Mock dependencies withr::local_options(list(shiny.otel.collect = "session")) local_mocked_bindings( as_attributes = function(x) x, .package = "otel" ) with_mocked_bindings( has_otel_collect = function(level) level == "session", otel_session_id_attrs = otel_session_id_attrs, # Use real function otel_session_attrs = otel_session_attrs, # Use real function with_otel_span = function(name, expr, attributes = NULL) { span_attributes <<- attributes force(expr) }, otel_log = function(...) {}, # Mock log function { expect_length(domain$cleanup_callbacks, 0) result <- otel_span_session_start({ "test_result" }, domain = domain) expect_equal(result, "test_result") # Check span attributes include both session ID and request info expect_equal(span_attributes[["session.id"]], "integration-test-session") expect_equal(span_attributes[["server.path"]], "/dashboard/") expect_equal(span_attributes[["server.address"]], "shiny.example.com") expect_equal(span_attributes[["server.port"]], 3838L) } ) })