testthat::test_that("Utility function parse_time works", { testthat::skip_on_ci() testthat::skip_on_cran() # unix timestamp doesn't contain the information about milliseconds test_unix_timestamp <- 1489700093 human_readable_date <- parse_time(test_unix_timestamp, origin = "1970-01-01", time_zone = "GMT" ) testthat::expect_equal(human_readable_date, "2017-03-16 21:34:53 GMT", label = "Epoch conversion to human-readable date went wrong." ) # unix timestamp contains the information about milliseconds test_unix_timestamp <- 2555971200000 human_readable_date <- parse_time(test_unix_timestamp, origin = "1970-01-01", time_zone = "GMT", use_milliseconds = TRUE ) testthat::expect_equal(human_readable_date, "2050-12-30 GMT", label = "Epoch conversion to human-readable date went wrong." ) # unix timestamp is missing test_unix_timestamp <- NA human_readable_date <- parse_time(test_unix_timestamp, origin = "1970-01-01", time_zone = "", use_milliseconds = TRUE ) testthat::expect_equal(human_readable_date, "unknown", label = "Epoch conversion to human-readable date went wrong." ) # Setup test params for testing bad_reset_time_as_unix_epoch <- list(reset_time_as_unix_epoch = "bad") bad_origin <- list( reset_time_as_unix_epoch = 2555971200000, origin = FALSE ) bad_time_zone <- list( reset_time_as_unix_epoch = 2555971200000, origin = "string", time_zone = 1 ) bad_use_milliseconds <- list( reset_time_as_unix_epoch = 2555971200000, origin = "string", time_zone = "string", use_milliseconds = "bad" ) # Test with bad_reset_time_as_unix_epoch testthat::expect_error( do.call(parse_time, bad_reset_time_as_unix_epoch) ) # Test with bad_origin testthat::expect_error( do.call(parse_time, bad_origin) ) # Test with bad_time_zone testthat::expect_error( do.call(parse_time, bad_time_zone) ) # Test with bad_use_milliseconds testthat::expect_error( do.call(parse_time, bad_use_milliseconds) ) }) testthat::test_that("Utility function flatten_query works", { # Load predefined unflattened query params list unflattened_query_params_list <- list( limit = 50, offset = 0, fields = list( "created_by", "name", "id" ) ) # Use the flatten_query function flattened_query_params_list <- flatten_query(unflattened_query_params_list) # Define the expected output expected_resulting_list <- list( limit = 50, offset = 0, fields = "created_by", fields = "name", fields = "id" ) keys <- names(flattened_query_params_list) # Compare two lists testthat::expect_equal( flattened_query_params_list[keys], expected_resulting_list[keys] ) # check with length 1 lists unflattened_query_params_list <- list( limit = 50, offset = 0, tags = list("api") ) # Use the flatten_query function flattened_query_params_list <- flatten_query(unflattened_query_params_list) # Define the expected output expected_resulting_list <- list( limit = 50, offset = 0, tags = "api" ) keys <- names(flattened_query_params_list) # Compare two lists testthat::expect_equal( flattened_query_params_list[keys], expected_resulting_list[keys] ) }) testthat::test_that("Utility function handle_url2 works", { # Check call without url and handle err <- testthat::expect_error(handle_url2(url = NULL, handle = NULL)) testthat::expect_equal( err$message, "Must specify at least one of url or handle." ) # Test output - url provided result <- handle_url2( url = "https://api.sbgenomics.com/v2/user/", query = list(limit = 50, offset = 50) ) testthat::expect_true(!is.null(result$handle)) testthat::expect_true(checkmate::test_class(result$handle, classes = c("handle") )) testthat::expect_true(checkmate::test_class(result$handle$handle, classes = c("curl_handle") )) testthat::expect_true(!is.null(result$url)) testthat::expect_equal( result$url, "https://api.sbgenomics.com/v2/user/?limit=50&offset=50" ) }) testthat::test_that("Utility function build_url2 works", { # test build_url2 output url_test_object <- readRDS(testthat::test_path( "test_data", "url_test_object.RDS" )) # apply build_url2 function to generate final url resulting_url <- build_url2(url_test_object) testthat::expect_equal( resulting_url, "https://api.sbgenomics.com/v2/user/?limit=50&offset=0" ) # check if the function throws an error if the provided url object contains # password without username url_test_object <- readRDS(testthat::test_path( "test_data", "url_test_object_with_password_without_username.RDS" )) # apply build_url2 function to generate final url err <- testthat::expect_error(build_url2(url_test_object)) testthat::expect_equal(err$message, "Cannot set password without username") }) testthat::test_that("Utility function set_headers works when authorization = FALSE", { # nolint token <- stringi::stri_rand_strings(1, 32, pattern = "[a-z0-9]") # Test set_headers when authorization parameter is FALSE (default) headers <- set_headers(token = token) testthat::expect_equal(typeof(headers), "character", label = glue::glue("Headers should be a vector of characters, not {typeof(headers)}.") ) testthat::expect_equal(length(headers), 3L, label = "Headers vector should have three elements: X-SBG-Auth-Token, Accept and Content-Type" ) testthat::expect_equal(names(headers), c( "X-SBG-Auth-Token", "Accept", "Content-Type" ), label = "Elements in headers vector do not have expected names." ) testthat::expect_equal(unname(headers), c( token, "application/json", "application/json" ), label = "Headers elements are not as-expected." ) }) testthat::test_that("Utility function set_headers works when authorization = FALSE and advance_access = TRUE", { # nolint token <- stringi::stri_rand_strings(1, 32, pattern = "[a-z0-9]") # Test set_headers when authorization parameter is FALSE (default) headers <- set_headers(token = token, advance_access = TRUE) testthat::expect_equal(typeof(headers), "character", label = glue::glue("Headers should be a vector of characters, not {typeof(headers)}.") ) testthat::expect_equal(length(headers), 4L, label = "Headers vector should have three elements: X-SBG-Auth-Token, Accept, Content-Type and X-SBG-advance-access " ) testthat::expect_equal(names(headers), c( "X-SBG-Auth-Token", "Accept", "Content-Type", "X-SBG-advance-access" ), label = "Elements in headers vector do not have expected names." ) testthat::expect_equal(unname(headers), c( token, "application/json", "application/json", "advance" ), label = "Headers elements are not as-expected." ) }) testthat::test_that("Utility function set_headers works when authorization = TRUE", { # nolint token <- stringi::stri_rand_strings(1, 32, pattern = "[a-z0-9]") # Test set_headers when authorization parameter is TRUE headers <- set_headers( authorization = TRUE, token = token, client_info = "info" ) testthat::expect_equal(typeof(headers), "character", label = glue::glue("Headers should be a named character vector, not {typeof(headers)}.") # nolint ) testthat::expect_equal( length(headers), expected = 4, label = "Headers should have four values." ) testthat::expect_equal( object = names(headers), expected = c("Authorization", "Accept", "Content-Type", "User-Agent"), label = "The header names should be Authorization, Accept, Content-Type, User-Agent." # nolint ) testthat::expect_equal( unname(headers["Authorization"]), glue::glue("Bearer {token}"), label = "Headers element is not as-expected." ) }) testthat::test_that("Utility function set_headers throws an error if token isnot provided", { # nolint err <- testthat::expect_error(set_headers(token = NULL)) testthat::expect_equal(err$message, "Token is missing.") }) testthat::test_that("Utility function setup_query works", { query <- list(limit = 10L, offset = 5L) fields <- c("name", "id", "created_by") query <- setup_query( query = query, limit = getOption("sevenbridges2")$limit, offset = getOption("sevenbridges2")$offset, fields = fields ) # Set expected query list expected_query_list <- list( limit = 10L, offset = 5, fields = "name", fields = "id", fields = "created_by" ) keys <- names(query) # Compare the two lists testthat::expect_equal(query[keys], expected_query_list[keys]) }) testthat::test_that("Utility function setup_body works", { method <- sample(c("POST", "PATCH", "PUT"), 1) # Check if the function setup_query throws an error when body is not a list test_body <- c(name = "test") err <- testthat::expect_error(setup_body(method = method, body = test_body)) testthat::expect_equal(err$message, "Body should be a list.") # Check setup_query function output test_body <- readRDS(testthat::test_path( "test_data", "new_project_body.RDS" )) testthat::expect_true(is.list(test_body)) body_param_json <- setup_body(method = method, body = test_body) expected_body_json <- readRDS(testthat::test_path( "test_data", "new_project_expected_body_json.RDS" )) testthat::expect_equal(body_param_json, expected_body_json) }) testthat::test_that("Utility function m.fun works", { # test output when exact parameter is FALSE, and ignore.case is TRUE term <- "api" search_through_vector <- c( "element 1", "element 2 api", "element 3", "element 4 API", "element 5", "element 6", "api", "element 8" ) match_index_vector <- m.fun( x = term, y = search_through_vector, exact = FALSE, ignore.case = TRUE ) testthat::expect_equal( match_index_vector, c(2, 4, 7) ) # unnamed vector of match indexes # test output when exact parameter is FALSE, and ignore.case is FALSE match_index_vector <- m.fun( x = term, y = search_through_vector, exact = FALSE, ignore.case = FALSE ) testthat::expect_equal( match_index_vector, c(2, 7) ) # unnamed vector of match indexes # test output when exact parameter is TRUE, and ignore.case is TRUE match_index_vector <- m.fun( x = term, y = search_through_vector, exact = TRUE, ignore.case = TRUE ) testthat::expect_equal(match_index_vector, c(7)) # named vector # test output when exact parameter is FALSE, # and ignore.case is TRUE and there is only one match term <- "element 1" match_index_vector <- m.fun( x = term, y = search_through_vector, exact = FALSE, ignore.case = TRUE ) testthat::expect_equal( match_index_vector, c(`element 1` = 1) ) # named vector of match indexes }) testthat::test_that("Utility function m.match works", { # Test output when exact parameter is FALSE, # ignore.case is TRUE (id = NULL and name != NULL) search_through_list <- list( list(name = "project 1", id = "asdf1234"), list(name = "project 2", id = "qwer9876"), list(name = "project 3", id = "xyzq2234"), list(name = "project 3", id = "mnbv0192"), list(name = "project 4", id = "aeio5647") ) matchings <- m.match( obj = search_through_list, id = NULL, name = "project 3", exact = FALSE, ignore.case = TRUE ) # Set expected matchings list expected_matchings <- list( list(name = "project 3", id = "xyzq2234"), list(name = "project 3", id = "mnbv0192") ) keys <- names(matchings) # Compare the two lists testthat::expect_equal(matchings[keys], expected_matchings[keys]) # Test output when exact parameter is FALSE, ignore.case is TRUE # (id != NULL and name = NULL) search_through_list <- list( list(name = "project 1", id = "asdf1234"), list(name = "project 2", id = "qwer9876"), list(name = "project 3", id = "xyzq2234"), list(name = "project 3", id = "mnbv0192"), list(name = "project 4", id = "aeio5647") ) matchings <- m.match( obj = search_through_list, id = "xyzq2234", name = NULL, exact = FALSE, ignore.case = TRUE ) # Set expected matchings list expected_matchings <- list(name = "project 3", id = "xyzq2234") keys <- names(matchings) # Compare the two lists testthat::expect_equal(matchings[keys], expected_matchings[keys]) # Test output when exact parameter is FALSE, and ignore.case is FALSE # (no matchings) matchings <- m.match( obj = search_through_list, id = NULL, name = "PROJECT 3", exact = FALSE, ignore.case = FALSE ) testthat::expect_equal(matchings, list()) # Test output when exact parameter is FALSE, and ignore.case is TRUE }) # nolint start testthat::test_that("Utility function check_and_transform_id from objects works", { # nolint end ## Project class ----- # Check if function extract ID of instance test_project_id <- check_and_transform_id(setup_project_obj, "Project") # Is returned id a character vector testthat::expect_vector(test_project_id, ptype = character()) # throws an error if Project instance tried to treat as File testthat::expect_error( check_and_transform_id(setup_project_obj, "File"), "Must inherit from class 'File', but has classes 'Project','Item','R6'." ) ## File class ----- # Check if function extract ID of instance test_file_id <- check_and_transform_id(setup_file_obj, "File") # Is returned id a character vector testthat::expect_vector(test_file_id, ptype = character()) # throws an error if File instance tried to treat as a wrong class testthat::expect_error( check_and_transform_id(setup_file_obj, "Project"), "Must inherit from class 'Project', but has classes 'File','Item','R6" ) ## Upload class ----- # authentication obstacles ## Billing class ----- test_biling_id <- check_and_transform_id(setup_billing_obj, "Billing") # Is returned id a character vector testthat::expect_vector(test_biling_id, ptype = character()) # throws an error if billing instance tried to treat as a wrong class testthat::expect_error( check_and_transform_id(setup_billing_obj, "Project"), "Must inherit from class 'Project', but has classes 'Billing','Item','R6'." ) }) # nolint start testthat::test_that("Utility function check_and_transform_id with ID as string works", { # nolint end valid_id <- c( "luna_lovegood/nargles-project", "643536f886c9522d97347edd", "asdfg123-1234-1234-ab12-7e7e7e777abc" ) for (id in valid_id) { testthat::expect_vector(check_and_transform_id(id), ptype = character()) } }) # nolint start test_that("Utility function check_and_transform_id throws error when ID is not valid", { # nolint end # ID have to be character string invalid_id <- c(TRUE, 123) for (id in invalid_id) { testthat::expect_error(check_and_transform_id(id)) } }) test_that("Utility function input_matrix works as expected", { simulated_raw_cwl <- list(inputs = setup_app_inputs_list) inputs_info <- input_matrix(simulated_raw_cwl) testthat::expect_true( checkmate::test_class(inputs_info, classes = "data.frame") ) testthat::expect_equal(ncol(inputs_info), 4) testthat::expect_equal(nrow(inputs_info), 9) testthat::expect_true( all(c("id", "label", "type", "required") %in% names(inputs_info)) ) }) test_that("Utility function make_type works as expected", { # Get example of one File type file_type <- setup_app_inputs_list[[3]] make_type <- make_type(file_type$type) testthat::expect_equal(make_type, "File") # Get example of one File array type file_type <- setup_app_inputs_list[[2]] make_type <- make_type(file_type$type) testthat::expect_equal(make_type, "File...") # Get example of one integer type int_type <- setup_app_inputs_list[[5]] make_type <- make_type(int_type$type) testthat::expect_equal(make_type, "int?") # Get example of one enum type enum_type <- setup_app_inputs_list[[7]] make_type <- make_type(enum_type$type) testthat::expect_equal(make_type, "enum") }) test_that("Utility function find_type works as expected", { simple_list_enum <- list("enum") testthat::expect_equal(find_type(simple_list_enum), "null") simple_list_null <- list("null") testthat::expect_equal(find_type(simple_list_null), "null") named_list_enum <- list(type = "enum") testthat::expect_equal(find_type(named_list_enum), "enum") named_list_nested <- list(symbols = list(1, 2, 3)) testthat::expect_equal(find_type(named_list_nested), "null") named_list_string <- list(name = "name") testthat::expect_equal(find_type(named_list_string), "null") simple_value_null <- "null" testthat::expect_equal(find_type(simple_value_null), "null") simple_value <- "File" testthat::expect_equal(find_type(simple_value), "File") simple_list_w_type <- list(type = "array", items = "File") testthat::expect_equal(find_type(simple_list_w_type), "File...") simple_list_w_type_enum <- list( type = "enum", symbols = list(1, 2, 3, 4), name = "Sample_Tags_Version" ) testthat::expect_equal(find_type(simple_list_w_type_enum), "enum") string_vector <- c("null", "File") testthat::expect_equal(find_type(string_vector), "File") }) test_that("Utility function is_required works as expected", { # Get example of one optional field with first 'null' value example_list <- list(type = list("null", type = "File")) testthat::expect_false(is_required(example_list)) # Get example of one optional field containing ? example_string <- list(type = "int?") testthat::expect_false(is_required(example_string)) # Get example of one required field example_list <- list(type = list(type = "File")) testthat::expect_true(is_required(example_list)) # Get example of one required field example_string <- list(type = "int") testthat::expect_true(is_required(example_string)) }) test_that("Utility function output_matrix works as expected", { simulated_raw_cwl <- list(outputs = setup_app_outputs_list) outputs_info <- output_matrix(simulated_raw_cwl) testthat::expect_true( checkmate::test_class(outputs_info, classes = "data.frame") ) testthat::expect_equal(ncol(outputs_info), 3) testthat::expect_equal(nrow(outputs_info), 11) testthat::expect_true( all(c("id", "label", "type") %in% names(outputs_info)) ) }) test_that("Utility function lists_eq works as expected", { list2_to_compare <- list1_to_compare testthat::expect_true(lists_eq(list1_to_compare, list2_to_compare)) }) test_that("Utility function lists_eq throws error when expected", { list2_to_compare <- list1_to_compare list2_to_compare$error <- list(error = "error message") testthat::expect_false(lists_eq(list1_to_compare, list2_to_compare)) list3_to_compare <- list1_to_compare list3_to_compare$content <- c("123", "345", "4t45") testthat::expect_false(lists_eq(list1_to_compare, list3_to_compare)) })