test: xenon exposome

.gitignore

@@ -58,6 +58,3 @@ build/
 /application.yaml
 /application.properties
 .Rproj.user
-
-# R files
-.Rhistory

scripts/release/.gitignore

@@ -1,3 +1,5 @@
 .env
 Rplots.pdf
-molgenis-service-armadillo.Rproj
+molgenis-service-armadillo.Rproj
+.RData
+.Rhistory

scripts/release/README.md

@@ -29,6 +29,7 @@ To prevent all the questions:
 - copy the `dev.dist.env` to `.env`
 - fill in some or all parts
 - toggle the `interactive` to `n` or `y` to let the script wait for manual checks.
+- If you want to test as a researcher (not just in admin) ensure that you have added your email address to 'OIDC_EMAIL'
 - Specify tests you want to skip by adding them to the SKIP_TESTS in the .env file.
 Specify the name of the R script to skip without the .R extension, separated by 
 commas with no spaces. Eg: SKIP_TESTS = upload-resource,xenon-mediate

scripts/release/install_release_script_dependencies.R

@@ -61,6 +61,7 @@ install_github("datashield/dsBaseClient")
 install_github("datashield/dsMediationClient", ref = "0.0.3")
 install_github("https://github.com/transbioZI/dsMTLClient", ref = "0.9.9")
 install_github("neelsoumya/dsSurvivalClient") # There is no version for this package
+install_github("isglobal-brge/dsExposomeClient", ref = "2.0.8")
 
 # check if all packages are installed
 cli_alert_success("All packages are installed")

scripts/release/lib/common-functions.R

@@ -175,7 +175,6 @@ get_from_api_with_header <- function(endpoint, key, auth_type, url, user) {
   return(content(response))
 }
 
-
 # make authentication header for api calls, basic or bearer based on type
 get_auth_header <- function(type, key) {
   header_content <- ""
@@ -193,7 +192,6 @@ create_bearer_header <- function(token) {
   return(paste0("Bearer ", token))
 }
 
-
 print_list <- function(list) {
   vals_to_print <- cli_ul()
   for (i in 1:length(list)) {
@@ -202,3 +200,64 @@ print_list <- function(list) {
   }
   cli_end(vals_to_print)
 }
+
+verify_output <- function(function_name = NULL, object = NULL, expected = NULL, fail_msg = NULL){
+  if(identical(object, expected)) {
+    cli_alert_success(sprintf("%s passed", function_name))
+  } else {
+    cli_alert_danger(sprintf("%s failed", function_name))
+    exit_test(sprintf("%s %s", function_name, message))
+  }
+
+}
+
+set_dm_permissions <- function(user, admin_pwd, required_projects, interactive, update_auto, url) {
+  if (update_auto == "y") {
+    set_user(user, admin_pwd, T, required_projects, url)
+    cli_alert_info("Admin reset")
+  } else {
+    cli_alert_info("Make your account admin again")
+    wait_for_input(interactive)
+  }
+}
+
+download_many_sources <- function(ref, skip_tests) {
+  ref %>%
+    pmap(function(path, url, ...) {
+      prepare_resources(resource_path = path, url = url, skip_tests = skip_tests)
+    })
+}
+
+upload_many_sources <- function(project, ref, url, token, auth_type, folder, file_name, skip_tests) {
+  ref %>%
+    pmap(function(path, file_name, ...) {
+      upload_resource(project = project, rda_dir = path, url = url, token = token, folder = folder, file_name = file_name, auth_type = auth_type, skip_tests = NULL)
+    })
+}
+
+create_many_resources <- function(ref, project, folder, url, skip_tests) {
+  ref %>%
+    pmap(function(object_name, format, file_name, ...) {
+      create_resource(target_project = project, url = url, folder = folder, format = format, file_name = file_name, resource_name = object_name, skip_tests)
+    })
+}
+
+upload_many_resources <- function(project, resource, folder, ref) {
+  list(resource = resource, name = ref$object_name) %>%
+    pmap(function(resource, name) {
+      armadillo.upload_resource(project = project, folder = folder, resource = resource, name = name)
+    })
+}
+
+assign_many_resources <- function(project, folder, ref) {
+  ref$object_name %>%
+    map(function(x) {
+      exp_resource_path <- paste0(project, "/", folder, "/", x)
+      datashield.assign.resource(conns, resource = exp_resource_path, symbol = x)
+    })
+}
+
+resolve_many_resources <- function(resource_names) {
+  resource_names %>%
+    map(~ datashield.assign.expr(conns, symbol = .x, expr = as.symbol(paste0("as.resource.data.frame(", .x, ")"))))
+}

scripts/release/release-test.R

@@ -54,7 +54,7 @@ download_tables(dest = test_config$dest, service_location = test_config$service_
 
 cli_h2("Preparing resource for tests")
 source("test-cases/download-resources.R")
-prepare_resources(rda_dir = test_config$rda_dir, skip_tests = test_config$skip_tests)
+prepare_resources(resource_path = test_config$rda_dir, url = test_config$rda_url, skip_tests = test_config$skip_tests)
 
 cli_h2("Determining whether to run with password or token")
 source("test-cases/set-admin-mode.R")
@@ -85,11 +85,11 @@ upload_test_data(project = project1, dest = test_config$default_parquet_path, sk
 
 cli_h2("Uploading resource source file")
 source("test-cases/upload-resource.R")
-upload_resource(project = project1, rda_dir = test_config$rda_dir, url = test_config$armadillo_url, token = token, auth_type = test_config$auth_type, skip_tests = test_config$skip_tests)
+upload_resource(project = project1, rda_dir = test_config$rda_dir, url = test_config$armadillo_url, token = token, folder = "ewas", file_name = "gse66351_1.rda", auth_type = test_config$auth_type, skip_tests = test_config$skip_tests)
 
 cli_h2("Creating resource")
 source("test-cases/create-resource.R")
-resGSE1 <- create_resource(target_project = "u4mdd7wtwp", url = test_config$armadillo_url, skip_tests = test_config$skip_tests)
+resGSE1 <- create_resource(target_project = project1, url = test_config$armadillo_url, folder = "ewas", file_name = "gse66351_1.rda", resource_name = "GSE66351_1", format = "ExpressionSet", skip_tests = test_config$skip_tests)
 
 cli_h2("Uploading resource file")
 armadillo.upload_resource(project = project1, folder = "ewas", resource = resGSE1, name = "GSE66351_1")
@@ -136,14 +136,21 @@ cli_alert_info("Testing dsMTL")
 source("test-cases/xenon-mtl.R")
 verify_ds_mtl(skip_tests = test_config$skip_tests)
 
+cli_alert_info("Testing dsExposome")
+source("test-cases/xenon-exposome.R")
+run_exposome_tests(project = project1, url = test_config$armadillo_url, token = token, auth_type = test_config$auth_type, 
+                   ADMIN_MODE = test_config$ADMIN_MODE, profile = test_config$profile, profile_info = profile_info, 
+                   ref = exposome_ref, skip_tests = test_config$skip_tests, 
+                   user = test_config$user, admin_pwd = test_config$admin_pwd, interactive = test_config$interactive, 
+                   update_auto = test_config$update_auto)
+
 cli_h2("Removing data as admin")
 source("test-cases/remove-data.R") # Add link_project once module works
 dm_clean_up(user = test_config$user, admin_pwd = test_config$admin_pwd, required_projects = list(project1), update_auto = test_config$update_auto, url = test_config$armadillo_url, skip_tests = test_config$skip_tests, interactive = test_config$interactive)
 datashield.logout(conns)
 
 cli_h2("Testing basic authentification")
 source("test-cases/basic-auth.R")
-print(test_config$dest)
 verify_basic_auth(url = test_config$armadillo_url, admin_pwd = test_config$admin_pwd, dest = test_config$default_parquet_path, skip_tests = test_config$skip_tests)
 
 cli_alert_info("Testing done")

scripts/release/test-cases/basic-auth.R

@@ -1,32 +1,32 @@
-verify_basic_auth = function(url, admin_pwd, dest, skip_tests){
-  test_name = "basic_auth"
+verify_basic_auth <- function(url, admin_pwd, dest, skip_tests) {
+  test_name <- "basic_auth"
   if (do_skip_test(test_name, skip_tests)) {
     return()
   }
-
-  if(admin_pwd != "") {
-  cli_h2("Basic authentication")
-  cli_alert_info("Logging in as admin user")
-  armadillo.login_basic(url, "admin", admin_pwd)
-  project <- generate_random_project_name(skip_tests)
-  print(project)
-  cli_alert_info(sprintf("Creating project [%s]", project))
-  armadillo.create_project(project)
-  nonrep <- arrow::read_parquet(paste0(dest, "core/nonrep.parquet"))
-  cli_alert_info(sprintf("Uploading file to [%s]", project))
-  armadillo.upload_table(project, "2_1-core-1_0", nonrep)
-  rm(nonrep)
-  check_cohort_exists(project)
-  table <- sprintf("%s/2_1-core-1_0/nonrep", project)
-  if(table %in% armadillo.list_tables(project)){
-    cli_alert_success(paste0(table, " exists"))
+
+  if (admin_pwd != "") {
+    cli_h2("Basic authentication")
+    cli_alert_info("Logging in as admin user")
+    armadillo.login_basic(url, "admin", admin_pwd)
+    project <- generate_random_project_name(skip_tests)
+    print(project)
+    cli_alert_info(sprintf("Creating project [%s]", project))
+    armadillo.create_project(project)
+    nonrep <- arrow::read_parquet(paste0(dest, "core/nonrep.parquet"))
+    cli_alert_info(sprintf("Uploading file to [%s]", project))
+    armadillo.upload_table(project, "2_1-core-1_0", nonrep)
+    rm(nonrep)
+    check_cohort_exists(project)
+    table <- sprintf("%s/2_1-core-1_0/nonrep", project)
+    if (table %in% armadillo.list_tables(project)) {
+      cli_alert_success(paste0(table, " exists"))
+    } else {
+      exit_test(paste0(table, " doesn't exist"))
+    }
+    cli_alert_info(sprintf("Deleting [%s]", project))
+    armadillo.delete_project(project)
   } else {
-    exit_test(paste0(table, " doesn't exist"))
+    cli_alert_warning("Testing basic authentication skipped, admin password not available")
   }
-  cli_alert_info(sprintf("Deleting [%s]", project))
-  armadillo.delete_project(project)
-} else {
-  cli_alert_warning("Testing basic authentication skipped, admin password not available")
-}
   cli_alert_success(sprintf("%s passed!", test_name))
 }

scripts/release/test-cases/create-resource.R

@@ -1,4 +1,4 @@
-create_resource <- function(target_project, url, skip_tests) {
+create_resource <- function(target_project, url, folder, file_name, resource_name, format, skip_tests) {
   test_name <- "create_resource"
   if (do_skip_test(test_name, skip_tests)) {
     return()
@@ -10,9 +10,9 @@ create_resource <- function(target_project, url, skip_tests) {
   }
 
   created_resource <- resourcer::newResource(
-    name = "GSE66351_1",
-    url = sprintf("%sstorage/projects/%s/objects/ewas%sgse66351_1.rda", rds_url, target_project, "%2F"),
-    format = "ExpressionSet"
+    name = resource_name,
+    url = sprintf("%sstorage/projects/%s/objects/%s%s%s", rds_url, target_project, folder, "%2F", file_name),
+    format = format
   )
   cli_alert_success(sprintf("%s passed!", test_name))
   return(created_resource)

scripts/release/test-cases/download-resources.R

@@ -1,22 +1,17 @@
-prepare_resources <- function(rda_dir, skip_tests) {
-  test_name <- "prepare_resources"
-  if (do_skip_test(test_name, skip_tests)) {
-    return()
-  }
-
+prepare_resources <- function(resource_path, url, skip_tests) {
   test_name <- "prepare-resources"
   if (any(skip_tests %in% test_name)) {
     return(cli_alert_info(sprintf("Test '%s' skipped", test_name)))
   }
 
-  if (!file.exists(rda_dir)) {
-    cli_alert_warning("Unable to locate gse66351_1.rda in testing directory, downloading.")
-    download.file("https://github.com/isglobal-brge/brge_data_large/raw/master/data/gse66351_1.rda", rda_dir)
+  if (!file.exists(resource_path)) {
+    cli_alert_warning(sprintf("Unable to locate %s, downloading.", resource_path))
+    download.file(url, resource_path)
   }
 
   cli_alert_info("Checking if rda dir exists")
-  if (rda_dir == "" || !file.exists(rda_dir)) {
-    exit_test(sprintf("File [%s] doesn't exist", rda_dir))
+  if (resource_path == "" || !file.exists(resource_path)) {
+    exit_test(sprintf("File [%s] doesn't exist", resource_path))
   }
   cli_alert_success(sprintf("%s passed!", test_name))
 }

scripts/release/test-cases/download-tables.R

@@ -1,10 +1,10 @@
-create_dir_if_not_exists <- function(directory){
+create_dir_if_not_exists <- function(directory) {
   if (!dir.exists(paste0(dest, directory))) {
     dir.create(paste0(dest, directory))
   }
 }
 
-download_test_files <- function(urls, dest){
+download_test_files <- function(urls, dest) {
   n_files <- length(urls)
   cli_progress_bar("Downloading testfiles", total = n_files)
   for (i in 1:n_files) {
@@ -13,7 +13,7 @@ download_test_files <- function(urls, dest){
     folder <- splitted[length(splitted) - 1]
     filename <- splitted[length(splitted)]
     cli_alert_info(paste0("Downloading ", filename))
-    download.file(download_url, paste0(dest, folder, "/", filename), quiet=TRUE)
+    download.file(download_url, paste0(dest, folder, "/", filename), quiet = TRUE)
     cli_progress_update()
   }
   cli_progress_done()

scripts/release/test-cases/remove-data.R

@@ -1,15 +1,5 @@
 library(purrr)
 
-set_dm_permissions <- function(user, admin_pwd, required_projects, interactive, update_auto, url) {
-  if (update_auto == "y") {
-    set_user(user, admin_pwd, T, required_projects, url)
-    cli_alert_info("Admin reset")
-  } else {
-    cli_alert_info("Make your account admin again")
-    wait_for_input(interactive)
-  }
-}
-
 dm_delete_tables <- function() {
   armadillo.delete_table(project1, "2_1-core-1_0", "nonrep")
   armadillo.delete_table(project1, "2_1-core-1_0", "yearlyrep")

scripts/release/test-cases/setup-profiles.R

@@ -1,34 +1,34 @@
 generate_project_port <- function(current_project_ports) {
   starting_port <- 6312
   while (starting_port %in% current_project_ports) {
-    starting_port = starting_port + 1
+    starting_port <- starting_port + 1
   }
   return(starting_port)
 }
 
 obtain_existing_profile_information <- function(key, auth_type) {
-  responses <- get_from_api_with_header('ds-profiles', key, auth_type)
-  response_df <- data.frame(matrix(ncol=5,nrow=0, dimnames=list(NULL, c("name", "container", "port", "seed", "online"))))
+  responses <- get_from_api_with_header("ds-profiles", key, auth_type)
+  response_df <- data.frame(matrix(ncol = 5, nrow = 0, dimnames = list(NULL, c("name", "container", "port", "seed", "online"))))
   for (response in responses) {
-    if("datashield.seed" %in% names(response$options)) {
+    if ("datashield.seed" %in% names(response$options)) {
       datashield_seed <- response$options$datashield.seed
     } else {
       datashield_seed <- NA
     }
 
-    response_df[nrow(response_df) + 1,] = c(response$name, response$image, response$port, datashield_seed, response$container$status)
+    response_df[nrow(response_df) + 1, ] <- c(response$name, response$image, response$port, datashield_seed, response$container$status)
   }
   return(response_df)
 }
 
 return_list_without_empty <- function(to_empty_list) {
-  return(to_empty_list[to_empty_list != ''])
+  return(to_empty_list[to_empty_list != ""])
 }
 
 create_profile <- function(profile_name, key, auth_type, profile_defaults) {
   if (profile_name %in% profile_defaults$name) {
     cli_alert_info(sprintf("Creating profile: %s", profile_name))
-    profile_default <- profile_defaults[profile_defaults$name == profile_name,]
+    profile_default <- profile_defaults[profile_defaults$name == profile_name, ]
     current_profiles <- obtain_existing_profile_information(key, auth_type)
     new_profile_seed <- generate_random_project_seed(current_profiles$seed)
     whitelist <- as.list(stri_split_fixed(paste("dsBase", profile_default$whitelist, sep = ","), ",")[[1]])
@@ -46,7 +46,7 @@ create_profile <- function(profile_name, key, auth_type, profile_defaults) {
       functionBlacklist = return_list_without_empty(blacklist),
       options = list(datashield.seed = new_profile_seed)
     )
-    response <- put_to_api('ds-profiles', key, auth_type, body_args = args)
+    response <- put_to_api("ds-profiles", key, auth_type, body_args = args)
     if (response$status_code == 204) {
       cli_alert_success(sprintf("Profile %s successfully created.", profile_name))
       start_profile(profile_name, key, auth_type)
@@ -59,7 +59,7 @@ create_profile <- function(profile_name, key, auth_type, profile_defaults) {
 }
 
 generate_random_project_seed <- function(current_project_seeds) {
-  random_seed <- round(runif(1, min = 100000000, max=999999999))
+  random_seed <- round(runif(1, min = 100000000, max = 999999999))
   if (!random_seed %in% current_project_seeds) {
     return(random_seed)
   } else {