test_that("SecurityHeaders initializes with default parameters", { sec_headers <- SecurityHeaders$new() expect_s3_class(sec_headers, "SecurityHeaders") expect_s3_class(sec_headers, "R6") expect_true(sec_headers$name == "security_headers") # Test that all default values are set correctly expect_type(sec_headers$content_security_policy, "list") expect_null(sec_headers$content_security_policy_report_only) expect_null(sec_headers$cross_origin_embedder_policy) expect_equal(sec_headers$cross_origin_opener_policy, "same-origin") expect_equal(sec_headers$cross_origin_resource_policy, "same-origin") expect_true(sec_headers$origin_agent_cluster) expect_equal(sec_headers$referrer_policy, "no-referrer") expect_type(sec_headers$strict_transport_security, "list") expect_true(sec_headers$x_content_type_options) expect_false(sec_headers$x_dns_prefetch_control) expect_true(sec_headers$x_download_options) expect_equal(sec_headers$x_frame_options, "SAMEORIGIN") expect_equal(sec_headers$x_permitted_cross_domain_policies, "none") expect_false(sec_headers$x_xss_protection) }) test_that("SecurityHeaders initializes with custom parameters", { # Create custom CSP and STS values custom_csp <- csp( default_src = "none", script_src = c("self", "https://example.com"), style_src = "self" ) custom_sts <- sts( max_age = 31536000, # 1 year include_sub_domains = TRUE, preload = TRUE ) # Initialize with custom values sec_headers <- SecurityHeaders$new( content_security_policy = custom_csp, cross_origin_embedder_policy = "require-corp", strict_transport_security = custom_sts, x_frame_options = "DENY", x_xss_protection = TRUE ) # Verify custom values were set correctly # Note that validate_csp adds quotes to special keywords expect_equal(sec_headers$content_security_policy$default_src, "'none'") expect_equal(sec_headers$content_security_policy$script_src, c("'self'", "https://example.com")) expect_equal(sec_headers$content_security_policy$style_src, "'self'") expect_equal(sec_headers$cross_origin_embedder_policy, "require-corp") expect_equal(sec_headers$strict_transport_security, custom_sts) expect_equal(sec_headers$x_frame_options, "DENY") expect_true(sec_headers$x_xss_protection) }) test_that("content_security_policy field validates input", { sec_headers <- SecurityHeaders$new() # Test valid CSP update valid_csp <- csp(default_src = "self", script_src = "none") expect_no_error(sec_headers$content_security_policy <- valid_csp) # Note that validate_csp adds quotes around special keywords expect_equal(sec_headers$content_security_policy$default_src, "'self'") expect_equal(sec_headers$content_security_policy$script_src, "'none'") # Test setting to NULL expect_no_error(sec_headers$content_security_policy <- NULL) expect_null(sec_headers$content_security_policy) }) test_that("cross_origin_embedder_policy field validates input", { sec_headers <- SecurityHeaders$new() # Test valid values expect_no_error(sec_headers$cross_origin_embedder_policy <- "unsafe-none") expect_equal(sec_headers$cross_origin_embedder_policy, "unsafe-none") expect_no_error(sec_headers$cross_origin_embedder_policy <- "require-corp") expect_equal(sec_headers$cross_origin_embedder_policy, "require-corp") expect_no_error(sec_headers$cross_origin_embedder_policy <- "credentialless") expect_equal(sec_headers$cross_origin_embedder_policy, "credentialless") expect_no_error(sec_headers$cross_origin_embedder_policy <- NULL) expect_null(sec_headers$cross_origin_embedder_policy) # Test invalid value expect_snapshot(sec_headers$cross_origin_embedder_policy <- "invalid-value", error = TRUE) }) test_that("cross_origin_opener_policy field validates input", { sec_headers <- SecurityHeaders$new() # Test valid values expect_no_error(sec_headers$cross_origin_opener_policy <- "unsafe-none") expect_equal(sec_headers$cross_origin_opener_policy, "unsafe-none") expect_no_error(sec_headers$cross_origin_opener_policy <- "same-origin-allow-popups") expect_equal(sec_headers$cross_origin_opener_policy, "same-origin-allow-popups") expect_no_error(sec_headers$cross_origin_opener_policy <- "same-origin") expect_equal(sec_headers$cross_origin_opener_policy, "same-origin") expect_no_error(sec_headers$cross_origin_opener_policy <- "noopener-allow-popups") expect_equal(sec_headers$cross_origin_opener_policy, "noopener-allow-popups") expect_no_error(sec_headers$cross_origin_opener_policy <- NULL) expect_null(sec_headers$cross_origin_opener_policy) # Test invalid value expect_snapshot(sec_headers$cross_origin_opener_policy <- "invalid-value", error = TRUE) }) test_that("cross_origin_resource_policy field validates input", { sec_headers <- SecurityHeaders$new() # Test valid values expect_no_error(sec_headers$cross_origin_resource_policy <- "same-site") expect_equal(sec_headers$cross_origin_resource_policy, "same-site") expect_no_error(sec_headers$cross_origin_resource_policy <- "same-origin") expect_equal(sec_headers$cross_origin_resource_policy, "same-origin") expect_no_error(sec_headers$cross_origin_resource_policy <- "cross-origin") expect_equal(sec_headers$cross_origin_resource_policy, "cross-origin") expect_no_error(sec_headers$cross_origin_resource_policy <- NULL) expect_null(sec_headers$cross_origin_resource_policy) # Test invalid value expect_snapshot(sec_headers$cross_origin_resource_policy <- "invalid-value", error = TRUE) }) test_that("strict_transport_security field validates input", { sec_headers <- SecurityHeaders$new() # Test valid STS values valid_sts <- sts(max_age = 63072000, include_sub_domains = TRUE) expect_no_error(sec_headers$strict_transport_security <- valid_sts) expect_equal(sec_headers$strict_transport_security, valid_sts) # Test STS with preload valid_sts_preload <- sts( max_age = 31536000, # 1 year minimum required for preload include_sub_domains = TRUE, preload = TRUE ) expect_no_error(sec_headers$strict_transport_security <- valid_sts_preload) # Test invalid STS with preload (max_age too small) invalid_sts_preload <- list( max_age = 10000, # Too small for preload include_sub_domains = TRUE, preload = TRUE ) expect_snapshot(sec_headers$strict_transport_security <- invalid_sts_preload, error = TRUE) # Test invalid STS with preload (include_sub_domains missing) invalid_sts_preload2 <- list( max_age = 31536000, include_sub_domains = FALSE, preload = TRUE ) expect_snapshot(sec_headers$strict_transport_security <- invalid_sts_preload2, error = TRUE) # Test invalid STS structure expect_snapshot(sec_headers$strict_transport_security <- list(invalid = "value"), error = TRUE) }) test_that("boolean fields validate input correctly", { sec_headers <- SecurityHeaders$new() # Test origin_agent_cluster expect_no_error(sec_headers$origin_agent_cluster <- FALSE) expect_false(sec_headers$origin_agent_cluster) expect_no_error(sec_headers$origin_agent_cluster <- TRUE) expect_true(sec_headers$origin_agent_cluster) expect_no_error(sec_headers$origin_agent_cluster <- NULL) expect_null(sec_headers$origin_agent_cluster) # Test x_content_type_options expect_no_error(sec_headers$x_content_type_options <- FALSE) expect_false(sec_headers$x_content_type_options) expect_no_error(sec_headers$x_content_type_options <- TRUE) expect_true(sec_headers$x_content_type_options) expect_no_error(sec_headers$x_content_type_options <- NULL) expect_null(sec_headers$x_content_type_options) # Test x_xss_protection expect_no_error(sec_headers$x_xss_protection <- TRUE) expect_true(sec_headers$x_xss_protection) expect_no_error(sec_headers$x_xss_protection <- FALSE) expect_false(sec_headers$x_xss_protection) expect_no_error(sec_headers$x_xss_protection <- NULL) expect_null(sec_headers$x_xss_protection) # Test invalid boolean value expect_snapshot(sec_headers$origin_agent_cluster <- "not-a-boolean", error = TRUE) }) test_that("prepare_headers creates correct header values", { sec_headers <- SecurityHeaders$new() # We need to access the private method directly headers <- sec_headers$.__enclos_env__$private$prepare_headers() expect_type(headers, "list") expect_true("content-security-policy" %in% names(headers)) expect_true("cross-origin-opener-policy" %in% names(headers)) expect_true("cross-origin-resource-policy" %in% names(headers)) expect_true("origin-agent-cluster" %in% names(headers)) expect_true("referrer-policy" %in% names(headers)) expect_true("strict-transport-security" %in% names(headers)) expect_true("x-content-type-options" %in% names(headers)) expect_true("x-dns-prefetch-control" %in% names(headers)) expect_true("x-download-options" %in% names(headers)) expect_true("x-frame-options" %in% names(headers)) expect_true("x-permitted-cross-domain-policies" %in% names(headers)) expect_true("x-xss-protection" %in% names(headers)) # Check specific values expect_equal(headers[["cross-origin-opener-policy"]], "same-origin") expect_equal(headers[["cross-origin-resource-policy"]], "same-origin") expect_equal(headers[["origin-agent-cluster"]], "?1") expect_equal(headers[["referrer-policy"]], "no-referrer") expect_equal(headers[["x-content-type-options"]], "nosniff") expect_equal(headers[["x-dns-prefetch-control"]], "off") expect_equal(headers[["x-download-options"]], "noopen") expect_equal(headers[["x-frame-options"]], "SAMEORIGIN") expect_equal(headers[["x-permitted-cross-domain-policies"]], "none") expect_equal(headers[["x-xss-protection"]], "0") }) test_that("SecurityHeaders integrates with fiery", { skip_if_not_installed("fiery") # Create a fiery app and SecurityHeaders plugin app <- fiery::Fire$new() sec_headers <- SecurityHeaders$new( strict_transport_security = NULL # Disable STS to avoid protocol redirect setup ) # Should not error expect_no_error(app$attach(sec_headers)) # Check that headers were added to the app using the header() method # The header() method both sets and gets headers expect_true(!is.null(app$header("content-security-policy"))) expect_true(!is.null(app$header("cross-origin-opener-policy"))) expect_true(!is.null(app$header("cross-origin-resource-policy"))) # Test with STS enabled app2 <- fiery::Fire$new() sec_headers2 <- SecurityHeaders$new() expect_no_error(app2$attach(sec_headers2)) # Check that STS header was added and protocol upgrade route was created expect_true(!is.null(app2$header("strict-transport-security"))) expect_true(!is.null(app2$plugins$header_routr)) }) test_that("SecurityHeaders handles CSP with reporting endpoints", { # Create CSP with reporting endpoint csp_with_report <- csp( default_src = "self", report_to = "https://example.com/reports" ) sec_headers <- SecurityHeaders$new( content_security_policy = csp_with_report ) # Access private prepare_headers method directly headers <- sec_headers$.__enclos_env__$private$prepare_headers() # Check that reporting-endpoints header was created expect_true("reporting-endpoints" %in% names(headers)) expect_match(headers[["reporting-endpoints"]], "csp-endpoint=\"https://example.com/reports\"") # Check that report_to was translated to report_uri and endpoint name in CSP expect_match(headers[["content-security-policy"]], "report-to csp-endpoint") expect_match(headers[["content-security-policy"]], "report-uri https://example.com/reports") }) test_that("SecurityHeaders handles multiple reporting endpoints", { # Create CSP and CSPRO with different reporting endpoints csp_with_report <- csp( default_src = "self", report_to = "https://example.com/reports" ) cspro_with_report <- csp( default_src = "none", report_to = "https://example.com/report-only" ) sec_headers <- SecurityHeaders$new( content_security_policy = csp_with_report, content_security_policy_report_only = cspro_with_report ) # Access private prepare_headers method directly headers <- sec_headers$.__enclos_env__$private$prepare_headers() # Check that reporting-endpoints header has both endpoints expect_true("reporting-endpoints" %in% names(headers)) expect_match(headers[["reporting-endpoints"]], "csp-endpoint=\"https://example.com/reports\"") expect_match(headers[["reporting-endpoints"]], "cspro-endpoint=\"https://example.com/report-only\"") })