diff --git a/tests/testthat/helper-data_storage.R b/tests/testthat/helper-data_storage.R index 7d41f1f3..63b9ec77 100644 --- a/tests/testthat/helper-data_storage.R +++ b/tests/testthat/helper-data_storage.R @@ -1,92 +1,62 @@ #' Set of common tests for different data storage providers #' @param init_fun function to initialize data storage provider -#' @param provider_name string with name of data storage provider #' #' @keywords internal -test_that_common_data_storage <- function(init_fun, provider_name) { - testthat::test_that( - glue::glue( - .sep = " ", - provider_name, - "Can write to database via DataStorage" - ), - { - data_storage <- init_fun() - dashboard_name <- paste0("dashboard-", rlang::hash(Sys.time())) +it_common_data_storage <- function(init_fun) { + require(testthat) + dashboard_name <- function() sprintf("dashboard-%s", rlang::hash(Sys.time())) - test_common_data_storage(data_storage, dashboard_name) - } + # + do.call( + it, + list( + "Can write to database via DataStorage", + test_common_data_storage(init_fun(), dashboard_name()) + ), + envir = parent.frame() ) - testthat::test_that( - glue::glue( - .sep = " ", - provider_name, - "Insert and read events without details" + do.call( + it, + list( + "Insert and read events without details", + test_common_empty_details(init_fun(), dashboard_name()) ), - { - data_storage <- init_fun() - dashboard_name <- paste0("dashboard-", rlang::hash(Sys.time())) - - test_common_empty_details(data_storage, dashboard_name) - } + envir = parent.frame() ) - testthat::test_that( - glue::glue( - .sep = " ", - provider_name, - "Insert and read custom fields with length > 1" + do.call( + it, + list("Insert and read custom fields with length > 1", + test_common_len_gt_1(init_fun(), dashboard_name()) ), - { - data_storage <- init_fun() - dashboard_name <- paste0("dashboard-", rlang::hash(Sys.time())) - - test_common_len_gt_1(data_storage, dashboard_name) - } + envir = parent.frame() ) - testthat::test_that( - glue::glue( - .sep = " ", - provider_name, - "Insert and read custom fields with length > 1 on a pre-populated file" + do.call( + it, + list( + "Insert and read custom fields with length > 1 on a pre-populated file", + test_common_len_gt_1_alt(init_fun(), dashboard_name()) ), - { - data_storage <- init_fun() - dashboard_name <- paste0("dashboard-", rlang::hash(Sys.time())) - - test_common_len_gt_1_alt(data_storage, dashboard_name) - } + envir = parent.frame() ) - testthat::test_that( - glue::glue( - .sep = " ", - provider_name, - "Time column is writen / read correctly" + do.call( + it, + list("Time column is writen / read correctly", + test_common_read_date(init_fun(), dashboard_name()) ), - { - data_storage <- init_fun() - dashboard_name <- paste0("dashboard-", rlang::hash(Sys.time())) - - test_common_read_date(data_storage, dashboard_name) - } + envir = parent.frame() ) - testthat::test_that( - glue::glue( - .sep = " ", - provider_name, - "Date colimn is writen / read correctly" + do.call( + it, + list("Date column is writen / read correctly", + test_common_read_date(init_fun(), dashboard_name()) ), - { - data_storage <- init_fun() - dashboard_name <- paste0("dashboard-", rlang::hash(Sys.time())) - - test_common_read_date(data_storage, dashboard_name) - } + envir = parent.frame() ) } diff --git a/tests/testthat/test-auxiliary_functions.R b/tests/testthat/test-auxiliary_functions.R index 75d03d91..76dea13c 100644 --- a/tests/testthat/test-auxiliary_functions.R +++ b/tests/testthat/test-auxiliary_functions.R @@ -1,119 +1,113 @@ -test_that("Build valid SQL query", { +describe("build_query_sql: builds valid SQL query", { con <- odbc::dbConnect(RSQLite::SQLite(), ":memory:") - build_query_sql("table_name", .con = con) %>% - as.character() %>% - expect_equal("SELECT * FROM `table_name`") - days_ago <- lubridate::today() - 10 days_ago_double <- days_ago %>% lubridate::as_datetime() %>% as.double() days_future <- lubridate::today() + 15 days_future_double <- (days_future + 1) %>% lubridate::as_datetime() %>% as.double() - build_query_sql("table_name", days_ago, .con = con) %>% - as.character() %>% - expect_equal(glue::glue( - "SELECT * FROM `table_name` WHERE time >= {days_ago_double}" - )) + it("with no dates", { + build_query_sql("table_name", .con = con) %>% + as.character() %>% + expect_equal("SELECT * FROM `table_name`") + }) - build_query_sql("table_name", date_to = days_future, .con = con) %>% - as.character() %>% - expect_equal(glue::glue( - "SELECT * FROM `table_name` WHERE time < {days_future_double}" - )) + it("with date 'from'", { + build_query_sql("table_name", days_ago, .con = con) %>% + as.character() %>% + expect_equal(glue::glue( + "SELECT * FROM `table_name` WHERE time >= {days_ago_double}" + )) + }) - build_query_sql("table_name", days_ago, days_future, .con = con) %>% - as.character() %>% - expect_equal(glue::glue( - "SELECT * FROM `table_name`", - " WHERE time >= {days_ago_double}", - " AND time < {days_future_double}" - )) + it("with date 'to'", { + build_query_sql("table_name", date_to = days_future, .con = con) %>% + as.character() %>% + expect_equal(glue::glue( + "SELECT * FROM `table_name` WHERE time < {days_future_double}" + )) + }) - build_query_sql( - "table_name", - as.Date("2023-04-13"), - as.Date("2000-01-01"), - .con = con - ) %>% - as.character() %>% - expect_equal( - glue::glue( + it("with date 'from' and 'to'", { + build_query_sql("table_name", days_ago, days_future, .con = con) %>% + as.character() %>% + expect_equal(glue::glue( "SELECT * FROM `table_name`", - " WHERE time >= {lubridate::as_datetime('2023-04-13') %>% as.double()}", - " AND time < {lubridate::as_datetime('2000-01-02') %>% as.double()}" - ) - ) - + " WHERE time >= {days_ago_double}", + " AND time < {days_future_double}" + )) + }) }) -test_that("build_mongo_connection_string: Build valid string with NULL", { - expect_equal( - build_mongo_connection_string( - host = "localhost", - port = 27017, - username = NULL, - password = NULL, - authdb = NULL, - options = NULL - ), - "mongodb://localhost:27017/" - ) -}) +describe("build_mongo_connection_string: builds valid string", { + it("with NULL", { + expect_equal( + build_mongo_connection_string( + host = "localhost", + port = 27017, + username = NULL, + password = NULL, + authdb = NULL, + options = NULL + ), + "mongodb://localhost:27017/" + ) + }) -test_that("build_mongo_connection_string: Build valid string with user and pass", { - expect_equal( - build_mongo_connection_string( - host = "localhost", - port = 27017, - username = "a_user", - password = "a_pass", - authdb = NULL, - options = NULL - ), - "mongodb://a_user:a_pass@localhost:27017/" - ) -}) + it("with user and pass", { + expect_equal( + build_mongo_connection_string( + host = "localhost", + port = 27017, + username = "a_user", + password = "a_pass", + authdb = NULL, + options = NULL + ), + "mongodb://a_user:a_pass@localhost:27017/" + ) + }) -test_that("build_mongo_connection_string: Build valid string with `authdb`", { - expect_equal( - build_mongo_connection_string( - host = "localhost", - port = 27017, - username = NULL, - password = NULL, - authdb = "path_to_authdb", - options = NULL - ), - "mongodb://localhost:27017/path_to_authdb" - ) -}) + it("with `authdb`", { + expect_equal( + build_mongo_connection_string( + host = "localhost", + port = 27017, + username = NULL, + password = NULL, + authdb = "path_to_authdb", + options = NULL + ), + "mongodb://localhost:27017/path_to_authdb" + ) + }) -test_that("build_mongo_connection_string: Build valid string with `options`", { - expect_equal( - build_mongo_connection_string( - host = "localhost", - port = 27017, - username = NULL, - password = NULL, - authdb = NULL, - options = list("option1" = "value1", "option2" = "value2") - ), - "mongodb://localhost:27017/?option1=value1&option2=value2" - ) -}) + it("with `options`", { + expect_equal( + build_mongo_connection_string( + host = "localhost", + port = 27017, + username = NULL, + password = NULL, + authdb = NULL, + options = list("option1" = "value1", "option2" = "value2") + ), + "mongodb://localhost:27017/?option1=value1&option2=value2" + ) + }) -test_that("build_mongo_connection_string: Build valid string with all parameters", { - expect_equal( - build_mongo_connection_string( - host = "localhost", - port = 27017, - username = "a_user", - password = "a_pass", - authdb = "path_to_authdb", - options = list("option1" = "value1", "option2" = "value2") - ), - "mongodb://a_user:a_pass@localhost:27017/path_to_authdb?option1=value1&option2=value2" - ) + it("with all parameters", { + expect_equal( + build_mongo_connection_string( + host = "localhost", + port = 27017, + username = "a_user", + password = "a_pass", + authdb = "path_to_authdb", + options = list("option1" = "value1", "option2" = "value2") + ), + "mongodb://a_user:a_pass@localhost:27017/path_to_authdb?option1=value1&option2=value2" + ) + }) }) diff --git a/tests/testthat/test-data-storage-mariadb.R b/tests/testthat/test-data-storage-mariadb.R index a5c4fc4c..c5978a79 100644 --- a/tests/testthat/test-data-storage-mariadb.R +++ b/tests/testthat/test-data-storage-mariadb.R @@ -1,3 +1,3 @@ # Test suite common to data storages (see `helper-data_storage.R`) -test_that_common_data_storage(init_test_mariadb, "MariaDB") +describe("MariaDB", it_common_data_storage(init_test_mariadb)) diff --git a/tests/testthat/test-data-storage-mongodb.R b/tests/testthat/test-data-storage-mongodb.R index 0c3ec0bb..750b77b5 100644 --- a/tests/testthat/test-data-storage-mongodb.R +++ b/tests/testthat/test-data-storage-mongodb.R @@ -1,3 +1,3 @@ # Test suite common to data storages (see `helper-data_storage.R`) -test_that_common_data_storage(init_test_mongodb, "MongoDB") +describe("MongoDB", it_common_data_storage(init_test_mongodb)) diff --git a/tests/testthat/test-data-storage-mssqlserver.R b/tests/testthat/test-data-storage-mssqlserver.R index 8c890347..6e766b45 100644 --- a/tests/testthat/test-data-storage-mssqlserver.R +++ b/tests/testthat/test-data-storage-mssqlserver.R @@ -1,3 +1,3 @@ # Test suite common to data storages (see `helper-data_storage.R`) -test_that_common_data_storage(init_test_mssql, "MSSQLServer") +describe("MSSQLServer", it_common_data_storage(init_test_mssql)) diff --git a/tests/testthat/test-data-storage-postgresql.R b/tests/testthat/test-data-storage-postgresql.R index 8bb6fc6c..a003074d 100644 --- a/tests/testthat/test-data-storage-postgresql.R +++ b/tests/testthat/test-data-storage-postgresql.R @@ -2,10 +2,10 @@ # Test suite common to data storages (see `helper-data_storage.R`) withr::with_envvar( c("TEST_POSTGRESQL_DRIVER" = "RPostgres"), - code = test_that_common_data_storage(init_test_postgres, "PostgreSQL") + code = describe("PostgreSQL (RPostgres)", it_common_data_storage(init_test_postgres)) ) withr::with_envvar( c("TEST_POSTGRESQL_DRIVER" = "RPostgreSQL"), - code = test_that_common_data_storage(init_test_postgres, "PostgreSQL") + code = describe("PostgreSQL (RPostgreSQL)", it_common_data_storage(init_test_postgres)) ) diff --git a/tests/testthat/test-data_storage-logfile.R b/tests/testthat/test-data_storage-logfile.R index 9ddaa30d..6b406ede 100644 --- a/tests/testthat/test-data_storage-logfile.R +++ b/tests/testthat/test-data_storage-logfile.R @@ -1,3 +1,3 @@ # Test suite common to data storages (see `helper-data_storage.R`) -test_that_common_data_storage(init_test_logfile, "LogFile") +describe("LogFile", it_common_data_storage(init_test_logfile)) diff --git a/tests/testthat/test-data_storage-sqlite.R b/tests/testthat/test-data_storage-sqlite.R index 5d195250..a10bd1cb 100644 --- a/tests/testthat/test-data_storage-sqlite.R +++ b/tests/testthat/test-data_storage-sqlite.R @@ -1,3 +1,3 @@ # Test suite common to data storages (see `helper-data_storage.R`) -test_that_common_data_storage(init_test_sqlite, "SQLite") +describe("SQLite", it_common_data_storage(init_test_sqlite)) diff --git a/tests/testthat/test-helper-data_storage.R b/tests/testthat/test-helper-data_storage.R index 1ef8ab30..0c39ff4d 100644 --- a/tests/testthat/test-helper-data_storage.R +++ b/tests/testthat/test-helper-data_storage.R @@ -1,87 +1,89 @@ -test_that("skip_if_storage_config_missing empty config", { - expect_condition( - skip_if_storage_config_missing(list()), - "DataStorage config: Not available", - class = "skip" - ) -}) - -test_that("skip_if_storage_config_missing config with wrong data types", { - expect_condition( - skip_if_storage_config_missing(list(SOME_CONFIG = 2)), - "DataStorage config: Not available", - class = "skip" - ) -}) - -test_that("skip_if_storage_config_missing config with mixed data types (some wrong)", { - expect_condition( - skip_if_storage_config_missing(list(SOME_CONFIG = 2, OTHER = "SOMETHING")), - "DataStorage config: Not available", - class = "skip" - ) -}) - -test_that("skip_if_storage_config_missing config with wrong data types", { - expect_condition( - skip_if_storage_config_missing(list(SOME_CONFIG = NULL)), - "DataStorage config: Not available", - class = "skip" - ) - - expect_condition( - skip_if_storage_config_missing(list(SOME_CONFIG = "NULL", OTHER = NULL)), - "DataStorage config: Not available", - class = "skip" - ) -}) +describe("skip_if_storage_config_missing", { + it("empty config", { + expect_condition( + skip_if_storage_config_missing(list()), + "DataStorage config: Not available", + class = "skip" + ) + }) -test_that("skip_if_storage_config_missing config with empty definition", { - expect_condition( - skip_if_storage_config_missing(list(SOME_CONFIG = "")), - "DataStorage config: Not available", - class = "skip" - ) -}) + test_that("skip_if_storage_config_missing config with wrong data types", { + expect_condition( + skip_if_storage_config_missing(list(SOME_CONFIG = 2)), + "DataStorage config: Not available", + class = "skip" + ) + }) -test_that("skip_if_storage_config_missing config with empty argument", { - expect_error( - skip_if_storage_config_missing(), - "is missing" - ) -}) + test_that("skip_if_storage_config_missing config with mixed data types (some wrong)", { + expect_condition( + skip_if_storage_config_missing(list(SOME_CONFIG = 2, OTHER = "SOMETHING")), + "DataStorage config: Not available", + class = "skip" + ) + }) -test_that("skip_if_storage_config_missing config with valid configurations", { - expect_failure( + test_that("skip_if_storage_config_missing config with wrong data types", { expect_condition( - skip_if_storage_config_missing(list(SOME_CONFIG = "A_VALUE")), + skip_if_storage_config_missing(list(SOME_CONFIG = NULL)), "DataStorage config: Not available", class = "skip" ) - ) - storage_config <- list( - SOME_CONFIG = "A_VALUE", - SOME_CONFIG2 = "A_VALUE_2", - SOME_CONFIG3 = "A_VALUE_3", - SOME_CONFIG4 = "A_VALUE_4", - SOME_CONFIG5 = "2", - SOME_CONFIG6 = "....", - SOME_CONFIG7 = "_sdas_DASads", - SOME_CONFIG8 = "Lorem ipsum", - SOME_CONFIG9 = "dolor sit amet, consectetur adipiscing", - SOME_CONFIG10 = "elit, sed do eiusmod tempor", - SOME_CONFIG11 = "Duis aute - irure", - SOME_CONFIG12 = "122332", - SOME_CONFIG13 = "2131 asdda s1234312" - ) + expect_condition( + skip_if_storage_config_missing(list(SOME_CONFIG = "NULL", OTHER = NULL)), + "DataStorage config: Not available", + class = "skip" + ) + }) - expect_failure( + test_that("skip_if_storage_config_missing config with empty definition", { expect_condition( - skip_if_storage_config_missing(storage_config), + skip_if_storage_config_missing(list(SOME_CONFIG = "")), "DataStorage config: Not available", class = "skip" ) - ) + }) + + test_that("skip_if_storage_config_missing config with empty argument", { + expect_error( + skip_if_storage_config_missing(), + "is missing" + ) + }) + + test_that("skip_if_storage_config_missing config with valid configurations", { + expect_failure( + expect_condition( + skip_if_storage_config_missing(list(SOME_CONFIG = "A_VALUE")), + "DataStorage config: Not available", + class = "skip" + ) + ) + + storage_config <- list( + SOME_CONFIG = "A_VALUE", + SOME_CONFIG2 = "A_VALUE_2", + SOME_CONFIG3 = "A_VALUE_3", + SOME_CONFIG4 = "A_VALUE_4", + SOME_CONFIG5 = "2", + SOME_CONFIG6 = "....", + SOME_CONFIG7 = "_sdas_DASads", + SOME_CONFIG8 = "Lorem ipsum", + SOME_CONFIG9 = "dolor sit amet, consectetur adipiscing", + SOME_CONFIG10 = "elit, sed do eiusmod tempor", + SOME_CONFIG11 = "Duis aute + irure", + SOME_CONFIG12 = "122332", + SOME_CONFIG13 = "2131 asdda s1234312" + ) + + expect_failure( + expect_condition( + skip_if_storage_config_missing(storage_config), + "DataStorage config: Not available", + class = "skip" + ) + ) + }) }) diff --git a/tests/testthat/test-telemetry.R b/tests/testthat/test-telemetry.R index bb72b3fa..1e4bfb86 100644 --- a/tests/testthat/test-telemetry.R +++ b/tests/testthat/test-telemetry.R @@ -1,4 +1,4 @@ -test_that("Telemetry tests with mock data_storage layer", { +describe("Telemetry tests with mock data_storage layer", { data_storage <- list( insert = function( app_name, type, session = NULL, details = NULL, time = NULL @@ -36,102 +36,104 @@ test_that("Telemetry tests with mock data_storage layer", { # # 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() + it("login", { + telemetry$log_login( + username = "ben", + session = session + ) %>% expect_message("Writing type=login value: .*\"username\":\"ben\".*") + }) + + it("logout", { + telemetry$log_logout( + session = session + ) %>% expect_silent() + }) + + it("log_input simple usage", { + 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.*") + }) + + it("log_input simple usage with character", { + session$setInputs(uisidebar = "tab1") + telemetry$log_navigation( + input_id = "uisidebar", + session = session + ) %>% + expect_message("Writing type=navigation value: .*\"value\":\"tab1\".*") + }) + + it("log_input with matching values that don't match (no writes)", { + 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() + }) + + it("log_input with matching values that match (write)", { + 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.*") + }) + + it("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\".*") + }) + + it("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\".*") + }) + + it("log_input with tracking values (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\".*") + }) + + it("log_navigation_manual", { + telemetry$log_navigation_manual( + navigation_id = "sample", + value = "tab2", + session = session + ) %>% + expect_message("Writing type=navigation value: .*\"value\":\"tab2\".*") + }) }) diff --git a/vignettes/databases.Rmd b/vignettes/databases.Rmd index aada5535..1feae27b 100644 --- a/vignettes/databases.Rmd +++ b/vignettes/databases.Rmd @@ -22,7 +22,7 @@ The following databases are supported by `{shiny.telemetry}`: - [MariaDB](https://mariadb.org/documentation/) or [MySQL](https://dev.mysql.com/doc/refman/en/) - [MS SQL Server](https://learn.microsoft.com/en-us/sql/sql-server/) - [MongoDB](https://www.mongodb.com/docs/manual/) -- [SQLite](https://www.sqlite.org/docs.html) +- [SQLite](https://sqlite.org/docs.html) A requirements to use `{shiny.telemetry}` with external databases in a production environment is to have the database server running and a user with the necessary permissions to insert. A minimal setup should have a user that only has write/insert permissions to the `{shiny.telemetry}` table storing the events.