From 67c721c364372031cb9e5a9a3c1a9343f725cddd Mon Sep 17 00:00:00 2001 From: afwillia Date: Thu, 8 Feb 2024 09:34:16 -0800 Subject: [PATCH 01/52] WIP: add data compliance dashboard back to UI and uncomment the server code. --- server.R | 28 ++++++++++++++-------------- ui.R | 1 + 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/server.R b/server.R index 21177f24..648b61ca 100644 --- a/server.R +++ b/server.R @@ -554,20 +554,20 @@ shinyServer(function(input, output, session) { }, ignoreInit = TRUE) ######## Dashboard ######## - # dashboard( - # id = "dashboard", - # syn.store = syn_store, - # project.scope = selected$project, - # schema = selected$schema, - # schema.display.name = reactive(input$dropdown_datatype), - # disable.ids = c("box_pick_project", "box_pick_manifest"), - # ncores = ncores, - # access_token = access_token, - # fileview = selected$master_asset_view(), - # folder = selected$project(), - # schematic_api = dca_schematic_api, - # schema_url = data_model() - # ) + dashboard( + id = "dashboard", + syn.store = syn_store, + project.scope = selected$project, + schema = selected$schema, + schema.display.name = reactive(input$dropdown_datatype), + disable.ids = c("box_pick_project", "box_pick_manifest"), + ncores = ncores, + access_token = access_token, + fileview = selected$master_asset_view(), + folder = selected$project(), + schematic_api = dca_schematic_api, + schema_url = data_model() + ) manifest_url <- reactiveVal(NULL) diff --git a/ui.R b/ui.R index a9488286..380a31be 100644 --- a/ui.R +++ b/ui.R @@ -165,6 +165,7 @@ ui <- shinydashboardPlus::dashboardPage( class = "btn-primary-color" ) ), + dashboardUI("dashboard"), ), ), tabItem( From 6c36b42da82a0b7c706bc0ac91026328fd7c93c9 Mon Sep 17 00:00:00 2001 From: afwillia Date: Thu, 8 Feb 2024 15:51:59 -0800 Subject: [PATCH 02/52] Add dashboard after selecting data type --- ui.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ui.R b/ui.R index 380a31be..1c775ada 100644 --- a/ui.R +++ b/ui.R @@ -164,9 +164,8 @@ ui <- shinydashboardPlus::dashboardPage( actionButton("btn_project", "Next", class = "btn-primary-color" ) - ), - dashboardUI("dashboard"), - ), + ) + ) ), tabItem( tabName = "tab_folder", @@ -207,7 +206,8 @@ ui <- shinydashboardPlus::dashboardPage( "Skip to validation", class = "btn-primary-color" ) - ) + ), + dashboardUI("dashboard") ), ), tabItem( From 5cc0b819819ca0b95b82f2f233354df3477dfb4d Mon Sep 17 00:00:00 2001 From: afwillia Date: Thu, 8 Feb 2024 15:52:59 -0800 Subject: [PATCH 03/52] use schema name instead of direct input to label dashboard --- server.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server.R b/server.R index 648b61ca..aab560b2 100644 --- a/server.R +++ b/server.R @@ -559,7 +559,7 @@ shinyServer(function(input, output, session) { syn.store = syn_store, project.scope = selected$project, schema = selected$schema, - schema.display.name = reactive(input$dropdown_datatype), + schema.display.name = selected$schema(), disable.ids = c("box_pick_project", "box_pick_manifest"), ncores = ncores, access_token = access_token, From 6c5d77af8374a5a4dc39b3bcd04c175c1c37cac3 Mon Sep 17 00:00:00 2001 From: afwillia Date: Thu, 8 Feb 2024 15:53:53 -0800 Subject: [PATCH 04/52] Update schematic REST API functions --- R/schematic_rest_api.R | 75 +++++++++++-------- functions/schematic_rest_api.R | 128 +++++++++++++++++++++++---------- 2 files changed, 134 insertions(+), 69 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index 794c1afa..5e9d60a6 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -14,33 +14,33 @@ check_success <- function(x){ #' @param url URI of API endpoint #' @param access_token Synapse PAT #' @param asset_view ID of view listing all project data assets -#' @param dataset_id the parent ID of the manifest +#' @param manifest_id the parent ID of the manifest #' @param as_json if True return the manifest in JSON format #' @returns a csv of the manifest #' @export -manifest_download <- function(url = "http://localhost:3001/v1/manifest/download", access_token, asset_view, dataset_id, as_json=TRUE, new_manifest_name=NULL) { +manifest_download <- function(url = "http://localhost:3001/v1/manifest/download", access_token, manifest_id, as_json=TRUE, new_manifest_name=NULL) { request <- httr::GET( url = url, httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), query = list( - asset_view = asset_view, - dataset_id = dataset_id, + manifest_id = manifest_id, as_json = as_json, new_manifest_name = new_manifest_name ) ) check_success(request) - response <- httr::content(request, type = "application/json") + response <- httr::content(request, type = "text") + response <- fromJSON(gsub('NaN', '"NA"', response)) # Output can have many NULL values which get dropped or cause errors. Set them to NA - nullToNA <- function(x) { - x[sapply(x, is.null)] <- NA - return(x) - } - df <- do.call(rbind, lapply(response, rbind)) - nullToNA(df) - + # nullToNA <- function(x) { + # x[sapply(x, is.null)] <- NA + # return(x) + # } + # df <- do.call(rbind, lapply(response, rbind)) + # nullToNA(df) + response } #' schematic rest api to generate manifest @@ -115,8 +115,8 @@ manifest_populate <- function(url="http://localhost:3001/v1/manifest/populate", #' @export manifest_validate <- function(url="http://localhost:3001/v1/model/validate", schema_url="https://raw.githubusercontent.com/ncihtan/data-models/main/HTAN.model.jsonld", #nolint - data_type, file_name, restrict_rules=FALSE, project_scope = NULL, - access_token, asset_view = NULL) { + data_type, file_name = NULL, restrict_rules=FALSE, project_scope = NULL, + access_token, asset_view = NULL, json_str = NULL) { flattenbody <- function(x) { # A form/query can only have one value per name, so take @@ -137,16 +137,31 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", }, names(x), x, USE.NAMES = FALSE, SIMPLIFY = FALSE)) } - req <- httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view)), - body=list(file_name=httr::upload_file(file_name)) - ) + if (all(is.null(json_str), is.null(file_name))) { + stop("Must provide either a file to upload or a json") + } + + req <- ifelse(is.null(json_str), + httr::POST(url, + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), + query=flattenbody(list( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view)), + body=list(file_name=httr::upload_file(file_name)) + ), + httr::POST(url, + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), + query=flattenbody(list( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view, + json_str = json_str)) + )) # Format server error in a way validationResult can handle if (httr::http_status(req)$category == "Server error") { @@ -154,12 +169,12 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", list( list( "errors" = list( - Row = NA, Column = NA, Value = NA, - Error = sprintf("Cannot validate manifest: %s", - httr::http_status(req)$message) + Row = NA, Column = NA, Value = NA, + Error = sprintf("Cannot validate manifest: %s", + httr::http_status(req)$message) ) - ) - ) + ) + ) ) } check_success(req) @@ -258,7 +273,7 @@ storage_project_datasets <- function(url="http://localhost:3001/v1/storage/proje asset_view=asset_view, project_id=project_id) ) - + check_success(req) httr::content(req) } diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index c2db54ad..5e9d60a6 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -14,33 +14,33 @@ check_success <- function(x){ #' @param url URI of API endpoint #' @param access_token Synapse PAT #' @param asset_view ID of view listing all project data assets -#' @param dataset_id the parent ID of the manifest +#' @param manifest_id the parent ID of the manifest #' @param as_json if True return the manifest in JSON format #' @returns a csv of the manifest #' @export -manifest_download <- function(url = "http://localhost:3001/v1/manifest/download", access_token, asset_view, dataset_id, as_json=TRUE, new_manifest_name=NULL) { +manifest_download <- function(url = "http://localhost:3001/v1/manifest/download", access_token, manifest_id, as_json=TRUE, new_manifest_name=NULL) { request <- httr::GET( url = url, + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), query = list( - access_token = access_token, - asset_view = asset_view, - dataset_id = dataset_id, + manifest_id = manifest_id, as_json = as_json, new_manifest_name = new_manifest_name ) ) check_success(request) - response <- httr::content(request, type = "application/json") + response <- httr::content(request, type = "text") + response <- fromJSON(gsub('NaN', '"NA"', response)) # Output can have many NULL values which get dropped or cause errors. Set them to NA - nullToNA <- function(x) { - x[sapply(x, is.null)] <- NA - return(x) - } - df <- do.call(rbind, lapply(response, rbind)) - nullToNA(df) - + # nullToNA <- function(x) { + # x[sapply(x, is.null)] <- NA + # return(x) + # } + # df <- do.call(rbind, lapply(response, rbind)) + # nullToNA(df) + response } #' schematic rest api to generate manifest @@ -61,6 +61,7 @@ manifest_generate <- function(url="http://localhost:3001/v1/manifest/generate", strict_validation = FALSE) { req <- httr::GET(url, + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), query = list( schema_url=schema_url, title=title, @@ -69,7 +70,6 @@ manifest_generate <- function(url="http://localhost:3001/v1/manifest/generate", dataset_id=dataset_id, asset_view=asset_view, output_format=output_format, - access_token = access_token, strict_validation = strict_validation )) @@ -115,14 +115,53 @@ manifest_populate <- function(url="http://localhost:3001/v1/manifest/populate", #' @export manifest_validate <- function(url="http://localhost:3001/v1/model/validate", schema_url="https://raw.githubusercontent.com/ncihtan/data-models/main/HTAN.model.jsonld", #nolint - data_type, file_name, restrict_rules=FALSE) { - req <- httr::POST(url, - query=list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules), - body=list(file_name=httr::upload_file(file_name)) - ) + data_type, file_name = NULL, restrict_rules=FALSE, project_scope = NULL, + access_token, asset_view = NULL, json_str = NULL) { + + flattenbody <- function(x) { + # A form/query can only have one value per name, so take + # any values that contain vectors length >1 and + # split them up + # list(x=1:2, y="a") becomes list(x=1, x=2, y="a") + if (all(lengths(x)<=1)) return(x); + do.call("c", mapply(function(name, val) { + if (length(val)==1 || any(c("form_file", "form_data") %in% class(val))) { + x <- list(val) + names(x) <- name + x + } else { + x <- as.list(val) + names(x) <- rep(name, length(val)) + x + } + }, names(x), x, USE.NAMES = FALSE, SIMPLIFY = FALSE)) + } + + if (all(is.null(json_str), is.null(file_name))) { + stop("Must provide either a file to upload or a json") + } + + req <- ifelse(is.null(json_str), + httr::POST(url, + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), + query=flattenbody(list( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view)), + body=list(file_name=httr::upload_file(file_name)) + ), + httr::POST(url, + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), + query=flattenbody(list( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view, + json_str = json_str)) + )) # Format server error in a way validationResult can handle if (httr::http_status(req)$category == "Server error") { @@ -130,12 +169,12 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", list( list( "errors" = list( - Row = NA, Column = NA, Value = NA, - Error = sprintf("Cannot validate manifest: %s", - httr::http_status(req)$message) + Row = NA, Column = NA, Value = NA, + Error = sprintf("Cannot validate manifest: %s", + httr::http_status(req)$message) ) - ) - ) + ) + ) ) } check_success(req) @@ -161,12 +200,11 @@ model_submit <- function(url="http://localhost:3001/v1/model/submit", use_schema_label=TRUE, manifest_record_type="table_and_file", file_name, table_manipulation="replace", hide_blanks=FALSE) { req <- httr::POST(url, - #add_headers(Authorization=paste0("Bearer ", pat)), + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), query=list( schema_url=schema_url, data_type=data_type, dataset_id=dataset_id, - access_token=access_token, restrict_rules=restrict_rules, json_str=json_str, asset_view=asset_view, @@ -230,13 +268,12 @@ storage_project_datasets <- function(url="http://localhost:3001/v1/storage/proje access_token) { req <- httr::GET(url, - #add_headers(Authorization=paste0("Bearer ", pat)), + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), query=list( asset_view=asset_view, - project_id=project_id, - access_token=access_token) + project_id=project_id) ) - + check_success(req) httr::content(req) } @@ -254,9 +291,9 @@ storage_projects <- function(url="http://localhost:3001/v1/storage/projects", access_token) { req <- httr::GET(url, + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), query = list( - asset_view=asset_view, - access_token=access_token + asset_view=asset_view )) check_success(req) @@ -280,13 +317,12 @@ storage_dataset_files <- function(url="http://localhost:3001/v1/storage/dataset/ full_path=FALSE, access_token) { req <- httr::GET(url, - #add_headers(Authorization=paste0("Bearer ", pat)), + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), query=list( asset_view=asset_view, dataset_id=dataset_id, file_names=file_names, - full_path=full_path, - access_token=access_token)) + full_path=full_path)) check_success(req) httr::content(req) @@ -302,9 +338,9 @@ get_asset_view_table <- function(url="http://localhost:3001/v1/storage/assets/ta access_token, asset_view, return_type="json") { req <- httr::GET(url, + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), query=list( asset_view=asset_view, - access_token=access_token, return_type=return_type)) check_success(req) @@ -317,3 +353,17 @@ get_asset_view_table <- function(url="http://localhost:3001/v1/storage/assets/ta } +#' @param url URL of schematic API endpoint +#' @param schema_url URL of data model +#' @param relationship Argument to schematic graph_by_edge_type +#' @export +#' @importFrom httr GET content +graph_by_edge_type <- function(url = "https://schematic-dev.api.sagebionetworks.org/v1/schemas/get/graph_by_edge_type", + schema_url, relationship = "requiresDependency") { + req <- httr::GET(url = url, + query = list( + schema_url = schema_url, + relationship = relationship + )) + httr::content(req) +} From b1f185a8472893a427f366e3d832694fe1663243 Mon Sep 17 00:00:00 2001 From: afwillia Date: Thu, 8 Feb 2024 15:54:40 -0800 Subject: [PATCH 05/52] Update dashboard functions for updated schematic REST API --- functions/dashboardFuns.R | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index 0aeca5dd..437402de 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -12,7 +12,7 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= file_view <- switch(schematic_api, reticulate = syn.store$storageFileviewTable, rest = get_asset_view_table(url = file.path(api_uri, "v1/storage/assets/tables"), - input_token = access_token, + access_token = access_token, asset_view=fileview) ) %>% filter(grepl("synapse_storage_manifest_", name) & parentId %in% datasets) @@ -39,7 +39,6 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= ) cols <- setNames(rep("", length(cols)), cols) metadata <- bind_rows(cols)[0, ] - lapply(file_view$parentId, function(dataset) { # get manifest's synapse id(s) in each dataset folder manifest_ids <- file_view$id[file_view$parentId == dataset] @@ -56,9 +55,8 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= info <- synapse_get(id = id, auth = access_token) manifest <- manifest_download( url = file.path(api_uri, "v1/manifest/download"), - input_token = access_token, - asset_view = fileview, - dataset_id = info$parentId, + access_token = access_token, + manifest_id = info$id, as_json = TRUE ) @@ -76,6 +74,10 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= } }) + manifest_info <- bind_rows(manifest_info) + manifest_info <- unique(manifest_info) + manifest_info <- split(manifest_info, manifest_info$id) + if (length(manifest_info) > 0) { metadata <- parallel::mclapply(seq_along(manifest_info), function(i) { if (schematic_api == "reticulate"){ @@ -100,7 +102,7 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= } else if (schematic_api == "rest"){ info <- manifest_info[[i]] # extract manifest essential information for dashboard - manifest_path <- info["Path"] + manifest_path <- info$Path # See above - don't read from file, read from object #manifest_df <- data.table::fread(manifest_path) manifest_df <- manifest_dfs[[i]] @@ -110,15 +112,15 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= manifest_df$Component[1], NA_character_ ) metadata <- tibble( - SynapseID = info["id"], + SynapseID = info$id, Component = manifest_component, - CreatedOn = as.Date(info["createdOn"]), - ModifiedOn = as.Date(info["modifiedOn"]), + CreatedOn = info$createdOn, + ModifiedOn = info$modifiedOn, ModifiedUser = paste0("@", modified_user[[i]]), Path = manifest_path, - Folder = names(datasets)[which(datasets == info["parentId"])], - FolderSynId = info["parentId"], - manifest = manifest_df + Folder = names(datasets)[which(datasets == info$parentId)], + FolderSynId = info$parentId, + manifest = list(manifest_df) ) } }, mc.cores = ncores) %>% bind_rows() @@ -142,7 +144,8 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= #' @param metadata output from \code{get_dataset_metadata}. #' @param project.scope list of project ids used for cross-manifest validation #' @return data frame contains required data types for tree plot -validate_metadata <- function(metadata, project.scope, schematic_api, schema_url) { +validate_metadata <- function(metadata, project.scope, schematic_api, schema_url, + access_token) { stopifnot(is.list(project.scope)) if (nrow(metadata) == 0) { return(metadata) @@ -175,7 +178,8 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url rest = manifest_validate(url=file.path(api_uri, "v1/model/validate"), data_type=manifest$Component, schema_url = schema_url, - json_str = jsonlite::toJSON(manifest$manifest)) + access_token = access_token, + json_str = jsonlite::toJSON(manifest$manifest[[1]])) ) # clean validation res from schematicpy clean_res <- validationResult(validation_res, manifest$Component, dashboard = TRUE) From 2405502ab28c9b892757b791d85399385a63963a Mon Sep 17 00:00:00 2001 From: afwillia Date: Thu, 8 Feb 2024 15:55:20 -0800 Subject: [PATCH 06/52] WIP: update dashboard for schematic API changes --- modules/dashboard/dashboard.R | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/modules/dashboard/dashboard.R b/modules/dashboard/dashboard.R index b59f9184..4cbd7648 100644 --- a/modules/dashboard/dashboard.R +++ b/modules/dashboard/dashboard.R @@ -77,16 +77,16 @@ dashboard <- function(id, syn.store, project.scope, schema, schema.display.name, hide("toggle-btn-container") shinydashboardPlus::updateBox("box", action = "restore") }) - # retrieving data progress for dashboard should not be executed until dashboard visiable + # retrieving data progress for dashboard should not be executed until dashboard visible # get all uploaded manifests once the project/folder changed observeEvent(c(project.scope(), input$box$visible), { req(input$box$visible) # initiate partial loading screen for generating plot - dcWaiter( - "show", - id = ns("tab-container"), url = "www/img/logo.svg", custom_spinner = TRUE, - msg = "Loading, please wait...", style = "color: #000;", color = transparent(0.95) - ) + # dcWaiter( + # "show", + # id = ns("tab-container"), url = "www/img/logo.svg", custom_spinner = TRUE, + # msg = "Loading, please wait...", style = "color: #000;", color = transparent(0.95) + # ) # disable selection to prevent changes until all uploaded manifests are queried # make sure to use asis, otherwise it will add module's namespaces @@ -97,7 +97,7 @@ dashboard <- function(id, syn.store, project.scope, schema, schema.display.name, "rest" = storage_project_datasets(url=file.path(api_uri, "v1/storage/project/datasets"), asset_view = fileview, project_id=folder, - input_token=access_token), + access_token=access_token), "reticulate" = storage_projects_datasets_py(syn.store, project.scope()) ) folder_list <- list2Vector(folder_list) @@ -113,7 +113,8 @@ dashboard <- function(id, syn.store, project.scope, schema, schema.display.name, ) metadata <- validate_metadata(metadata, project.scope = list(project.scope()), - schematic_api = schematic_api, schema_url=schema_url) + schematic_api = schematic_api, schema_url=schema_url, + access_token=access_token) # update reactive value uploaded_manifests(metadata) }) From dbb528e99d0198f9de23ced7587004ff9fd28e88 Mon Sep 17 00:00:00 2001 From: afwillia Date: Fri, 9 Feb 2024 07:35:01 -0800 Subject: [PATCH 07/52] Pass schema name to dashboard without () --- server.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server.R b/server.R index aab560b2..9b6451b4 100644 --- a/server.R +++ b/server.R @@ -559,7 +559,7 @@ shinyServer(function(input, output, session) { syn.store = syn_store, project.scope = selected$project, schema = selected$schema, - schema.display.name = selected$schema(), + schema.display.name = selected$schema, disable.ids = c("box_pick_project", "box_pick_manifest"), ncores = ncores, access_token = access_token, From 8a58ba646ddae9a9c906d2b7a8f1ed2b26f6f8be Mon Sep 17 00:00:00 2001 From: afwillia Date: Fri, 9 Feb 2024 07:35:32 -0800 Subject: [PATCH 08/52] Move json_str logic inside an if/else statement --- R/schematic_rest_api.R | 44 ++++++++++++++++---------------- functions/schematic_rest_api.R | 46 ++++++++++++++++++---------------- 2 files changed, 47 insertions(+), 43 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index 5e9d60a6..800a2f31 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -141,27 +141,29 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", stop("Must provide either a file to upload or a json") } - req <- ifelse(is.null(json_str), - httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view)), - body=list(file_name=httr::upload_file(file_name)) - ), - httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view, - json_str = json_str)) - )) + if (is.null(json_str)) { + req <- httr::POST(url, + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), + query=flattenbody(list( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view)), + body=list(file_name=httr::upload_file(file_name)) + ) + } else { + req <- httr::POST(url, + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), + query=flattenbody(list( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view, + json_str = json_str)) + ) + } # Format server error in a way validationResult can handle if (httr::http_status(req)$category == "Server error") { diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index 5e9d60a6..eacc41aa 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -141,28 +141,30 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", stop("Must provide either a file to upload or a json") } - req <- ifelse(is.null(json_str), - httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view)), - body=list(file_name=httr::upload_file(file_name)) - ), - httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view, - json_str = json_str)) - )) - + if (is.null(json_str)) { + req <- httr::POST(url, + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), + query=flattenbody(list( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view)), + body=list(file_name=httr::upload_file(file_name)) + ) + } else { + req <- httr::POST(url, + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), + query=flattenbody(list( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view, + json_str = json_str)) + ) + } + # Format server error in a way validationResult can handle if (httr::http_status(req)$category == "Server error") { return( From 9f4e0d46198ceaddaa84b87f6a0fb332e3304b80 Mon Sep 17 00:00:00 2001 From: afwillia Date: Fri, 9 Feb 2024 07:52:54 -0800 Subject: [PATCH 09/52] specify encoding as UTF-8 in manifest download to silence a message. --- R/schematic_rest_api.R | 2 +- functions/schematic_rest_api.R | 36 +++++++++++++++++----------------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index 800a2f31..b58a9d61 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -30,7 +30,7 @@ manifest_download <- function(url = "http://localhost:3001/v1/manifest/download" ) check_success(request) - response <- httr::content(request, type = "text") + response <- httr::content(request, type = "text", encoding = "UTF-8") response <- fromJSON(gsub('NaN', '"NA"', response)) # Output can have many NULL values which get dropped or cause errors. Set them to NA diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index eacc41aa..b58a9d61 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -30,7 +30,7 @@ manifest_download <- function(url = "http://localhost:3001/v1/manifest/download" ) check_success(request) - response <- httr::content(request, type = "text") + response <- httr::content(request, type = "text", encoding = "UTF-8") response <- fromJSON(gsub('NaN', '"NA"', response)) # Output can have many NULL values which get dropped or cause errors. Set them to NA @@ -143,28 +143,28 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", if (is.null(json_str)) { req <- httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view)), - body=list(file_name=httr::upload_file(file_name)) + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), + query=flattenbody(list( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view)), + body=list(file_name=httr::upload_file(file_name)) ) } else { req <- httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view, - json_str = json_str)) + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), + query=flattenbody(list( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view, + json_str = json_str)) ) } - + # Format server error in a way validationResult can handle if (httr::http_status(req)$category == "Server error") { return( From 4e0107597a2f4a1a307c3414ab57f29dcdb67999 Mon Sep 17 00:00:00 2001 From: afwillia Date: Fri, 9 Feb 2024 07:56:01 -0800 Subject: [PATCH 10/52] Add waiter --- modules/dashboard/dashboard.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/modules/dashboard/dashboard.R b/modules/dashboard/dashboard.R index 4cbd7648..d5c0cb15 100644 --- a/modules/dashboard/dashboard.R +++ b/modules/dashboard/dashboard.R @@ -82,11 +82,11 @@ dashboard <- function(id, syn.store, project.scope, schema, schema.display.name, observeEvent(c(project.scope(), input$box$visible), { req(input$box$visible) # initiate partial loading screen for generating plot - # dcWaiter( - # "show", - # id = ns("tab-container"), url = "www/img/logo.svg", custom_spinner = TRUE, - # msg = "Loading, please wait...", style = "color: #000;", color = transparent(0.95) - # ) + dcWaiter( + "show", + id = ns("tab-container"), url = "www/img/logo.svg", custom_spinner = TRUE, + msg = "Loading, please wait..." + ) # disable selection to prevent changes until all uploaded manifests are queried # make sure to use asis, otherwise it will add module's namespaces From a537def20d2ad6edb0ed8074fcd20d1d3a238ce0 Mon Sep 17 00:00:00 2001 From: afwillia Date: Fri, 9 Feb 2024 10:38:59 -0800 Subject: [PATCH 11/52] WIP: Update validation endpoint for dashboard --- R/schematic_rest_api.R | 61 +++++++++++++++++++++++++++------- functions/schematic_rest_api.R | 61 +++++++++++++++++++++++++++------- 2 files changed, 98 insertions(+), 24 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index b58a9d61..a3996b43 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -143,15 +143,31 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", if (is.null(json_str)) { req <- httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view)), + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), + query=flattenbody(list( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view)), body=list(file_name=httr::upload_file(file_name)) ) + # req <- httr2::request(url) |> + # httr2::req_method("POST") |> + # httr2::req_error(is_error = \(resp) httr2::resp_status(resp) == 510) + # resp <- req |> + # httr2::req_headers( + # Authorization = sprintf("Bearer %s", access_token) + # ) |> + # httr2::req_url_query( + # schema_url=schema_url, + # data_type=data_type, + # restrict_rules=restrict_rules, + # project_scope = project_scope, + # asset_view = asset_view + # ) |> + # httr2::req_body_file(file_name) |> + # httr2::req_perform() } else { req <- httr::POST(url, httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), @@ -163,25 +179,46 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", asset_view = asset_view, json_str = json_str)) ) + # req <- httr2::request(url) |> + # httr2::req_method("POST") |> + # httr2::req_error(is_error = \(resp) httr2::resp_status(resp) == 510) + # resp <- req |> + # httr2::req_headers( + # Authorization = sprintf("Bearer %s", access_token) + # ) |> + # httr2::req_url_query( + # schema_url=schema_url, + # data_type=data_type, + # restrict_rules=restrict_rules, + # project_scope = project_scope, + # asset_view = asset_view, + # json_str = json_str + # ) |> + # httr2::req_perform() + } # Format server error in a way validationResult can handle - if (httr::http_status(req)$category == "Server error") { + #if (httr2::resp_is_error(resp)) { + if (httr::http_error(req)) { return( list( list( "errors" = list( Row = NA, Column = NA, Value = NA, Error = sprintf("Cannot validate manifest: %s", - httr::http_status(req)$message) + httr::http_status(req)$message + ) ) ) ) ) } - check_success(req) - annotation_status <- httr::content(req) - annotation_status + #httr2::resp_body_json(resp) + httr::content(req) + # check_success(req) + #annotation_status <- httr::content(req) + #annotation_status } diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index b58a9d61..a3996b43 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -143,15 +143,31 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", if (is.null(json_str)) { req <- httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view)), + httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), + query=flattenbody(list( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view)), body=list(file_name=httr::upload_file(file_name)) ) + # req <- httr2::request(url) |> + # httr2::req_method("POST") |> + # httr2::req_error(is_error = \(resp) httr2::resp_status(resp) == 510) + # resp <- req |> + # httr2::req_headers( + # Authorization = sprintf("Bearer %s", access_token) + # ) |> + # httr2::req_url_query( + # schema_url=schema_url, + # data_type=data_type, + # restrict_rules=restrict_rules, + # project_scope = project_scope, + # asset_view = asset_view + # ) |> + # httr2::req_body_file(file_name) |> + # httr2::req_perform() } else { req <- httr::POST(url, httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), @@ -163,25 +179,46 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", asset_view = asset_view, json_str = json_str)) ) + # req <- httr2::request(url) |> + # httr2::req_method("POST") |> + # httr2::req_error(is_error = \(resp) httr2::resp_status(resp) == 510) + # resp <- req |> + # httr2::req_headers( + # Authorization = sprintf("Bearer %s", access_token) + # ) |> + # httr2::req_url_query( + # schema_url=schema_url, + # data_type=data_type, + # restrict_rules=restrict_rules, + # project_scope = project_scope, + # asset_view = asset_view, + # json_str = json_str + # ) |> + # httr2::req_perform() + } # Format server error in a way validationResult can handle - if (httr::http_status(req)$category == "Server error") { + #if (httr2::resp_is_error(resp)) { + if (httr::http_error(req)) { return( list( list( "errors" = list( Row = NA, Column = NA, Value = NA, Error = sprintf("Cannot validate manifest: %s", - httr::http_status(req)$message) + httr::http_status(req)$message + ) ) ) ) ) } - check_success(req) - annotation_status <- httr::content(req) - annotation_status + #httr2::resp_body_json(resp) + httr::content(req) + # check_success(req) + #annotation_status <- httr::content(req) + #annotation_status } From acab7d4c29710add76fb9926732455a710b50a93 Mon Sep 17 00:00:00 2001 From: afwillia Date: Fri, 9 Feb 2024 10:39:43 -0800 Subject: [PATCH 12/52] Write manifest to temp file and send in body of validation request. --- functions/dashboardFuns.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index 437402de..709123ff 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -42,8 +42,6 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= lapply(file_view$parentId, function(dataset) { # get manifest's synapse id(s) in each dataset folder manifest_ids <- file_view$id[file_view$parentId == dataset] - - if (length(manifest_ids) > 0) { # in case, multiple manifests exist in the same dataset for (id in manifest_ids) { if (schematic_api == "reticulate"){ @@ -59,10 +57,14 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= manifest_id = info$id, as_json = TRUE ) + manifest_tempfile <- tempfile( + pattern = id, fileext = ".csv" + ) + readr::write_csv(manifest, manifest_tempfile) # refactor this not to write files but save in a object #tmp_man <- tempfile() - info$Path <- NA_character_ + info$Path <- manifest_tempfile #write_csv(manifest, tmp_man) manifest_dfs[[id]] <<- manifest manifest_info <<- append(manifest_info, list(unlist(info))) @@ -71,7 +73,6 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= } } - } }) manifest_info <- bind_rows(manifest_info) @@ -104,8 +105,8 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= # extract manifest essential information for dashboard manifest_path <- info$Path # See above - don't read from file, read from object - #manifest_df <- data.table::fread(manifest_path) - manifest_df <- manifest_dfs[[i]] + manifest_df <- readr::read_csv(manifest_path) + #manifest_df <- manifest_dfs[[i]] # keep all manifests used for validation, even if it has invalid component value # if manifest doesn't have "Component" column, or empty, return NA for component manifest_component <- ifelse("Component" %in% colnames(manifest_df) & nrow(manifest_df) > 0, @@ -150,7 +151,6 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url if (nrow(metadata) == 0) { return(metadata) } - lapply(1:nrow(metadata), function(i) { manifest <- metadata[i, ] if (is.na(manifest$Component)) { @@ -179,7 +179,7 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url data_type=manifest$Component, schema_url = schema_url, access_token = access_token, - json_str = jsonlite::toJSON(manifest$manifest[[1]])) + file_name = manifest$Path) ) # clean validation res from schematicpy clean_res <- validationResult(validation_res, manifest$Component, dashboard = TRUE) From a49c88546ed3766a641525d6954136bbe9cb2cb1 Mon Sep 17 00:00:00 2001 From: afwillia Date: Fri, 9 Feb 2024 10:54:19 -0800 Subject: [PATCH 13/52] Remove commented code --- R/schematic_rest_api.R | 42 +++------------------------------- functions/schematic_rest_api.R | 42 +++------------------------------- 2 files changed, 6 insertions(+), 78 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index a3996b43..7e31e818 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -152,22 +152,6 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", asset_view = asset_view)), body=list(file_name=httr::upload_file(file_name)) ) - # req <- httr2::request(url) |> - # httr2::req_method("POST") |> - # httr2::req_error(is_error = \(resp) httr2::resp_status(resp) == 510) - # resp <- req |> - # httr2::req_headers( - # Authorization = sprintf("Bearer %s", access_token) - # ) |> - # httr2::req_url_query( - # schema_url=schema_url, - # data_type=data_type, - # restrict_rules=restrict_rules, - # project_scope = project_scope, - # asset_view = asset_view - # ) |> - # httr2::req_body_file(file_name) |> - # httr2::req_perform() } else { req <- httr::POST(url, httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), @@ -179,27 +163,9 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", asset_view = asset_view, json_str = json_str)) ) - # req <- httr2::request(url) |> - # httr2::req_method("POST") |> - # httr2::req_error(is_error = \(resp) httr2::resp_status(resp) == 510) - # resp <- req |> - # httr2::req_headers( - # Authorization = sprintf("Bearer %s", access_token) - # ) |> - # httr2::req_url_query( - # schema_url=schema_url, - # data_type=data_type, - # restrict_rules=restrict_rules, - # project_scope = project_scope, - # asset_view = asset_view, - # json_str = json_str - # ) |> - # httr2::req_perform() - } # Format server error in a way validationResult can handle - #if (httr2::resp_is_error(resp)) { if (httr::http_error(req)) { return( list( @@ -214,11 +180,9 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", ) ) } - #httr2::resp_body_json(resp) - httr::content(req) - # check_success(req) - #annotation_status <- httr::content(req) - #annotation_status + check_success(req) + annotation_status <- httr::content(req) + annotation_status } diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index a3996b43..7e31e818 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -152,22 +152,6 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", asset_view = asset_view)), body=list(file_name=httr::upload_file(file_name)) ) - # req <- httr2::request(url) |> - # httr2::req_method("POST") |> - # httr2::req_error(is_error = \(resp) httr2::resp_status(resp) == 510) - # resp <- req |> - # httr2::req_headers( - # Authorization = sprintf("Bearer %s", access_token) - # ) |> - # httr2::req_url_query( - # schema_url=schema_url, - # data_type=data_type, - # restrict_rules=restrict_rules, - # project_scope = project_scope, - # asset_view = asset_view - # ) |> - # httr2::req_body_file(file_name) |> - # httr2::req_perform() } else { req <- httr::POST(url, httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), @@ -179,27 +163,9 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", asset_view = asset_view, json_str = json_str)) ) - # req <- httr2::request(url) |> - # httr2::req_method("POST") |> - # httr2::req_error(is_error = \(resp) httr2::resp_status(resp) == 510) - # resp <- req |> - # httr2::req_headers( - # Authorization = sprintf("Bearer %s", access_token) - # ) |> - # httr2::req_url_query( - # schema_url=schema_url, - # data_type=data_type, - # restrict_rules=restrict_rules, - # project_scope = project_scope, - # asset_view = asset_view, - # json_str = json_str - # ) |> - # httr2::req_perform() - } # Format server error in a way validationResult can handle - #if (httr2::resp_is_error(resp)) { if (httr::http_error(req)) { return( list( @@ -214,11 +180,9 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", ) ) } - #httr2::resp_body_json(resp) - httr::content(req) - # check_success(req) - #annotation_status <- httr::content(req) - #annotation_status + check_success(req) + annotation_status <- httr::content(req) + annotation_status } From 2d96ba3d89d768433de77187a6ae7de4aebc1528 Mon Sep 17 00:00:00 2001 From: afwillia Date: Mon, 12 Feb 2024 08:37:43 -0800 Subject: [PATCH 14/52] Hide dashboard by default and show if use_compliance_dashboard env var is TRUE. --- server.R | 4 ++++ ui.R | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/server.R b/server.R index 9b6451b4..a06b32f7 100644 --- a/server.R +++ b/server.R @@ -194,6 +194,10 @@ shinyServer(function(input, output, session) { sass_file("www/scss/main.scss"))) }) + if (isTRUE(dcc_config_react()$dca$use_compliance_dashboard)) { + shinyjs::show("dashboard-toggle-btn-container") + } + dcWaiter("hide") dcWaiter("show", msg = paste0("Getting data. This may take a minute."), color = primary_col()) diff --git a/ui.R b/ui.R index 1c775ada..d7194580 100644 --- a/ui.R +++ b/ui.R @@ -207,7 +207,7 @@ ui <- shinydashboardPlus::dashboardPage( class = "btn-primary-color" ) ), - dashboardUI("dashboard") + shinyjs::hidden(dashboardUI("dashboard")) ), ), tabItem( From 4f7370da832798477d3cf96b1475e993318f7319 Mon Sep 17 00:00:00 2001 From: afwillia Date: Tue, 13 Feb 2024 12:26:58 -0800 Subject: [PATCH 15/52] Add a js message to enable dashboard based on dcc config. --- server.R | 10 +++++----- ui.R | 8 ++++++-- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/server.R b/server.R index a06b32f7..5a5bd539 100644 --- a/server.R +++ b/server.R @@ -193,10 +193,6 @@ shinyServer(function(input, output, session) { sidebar_col=dcc_config_react()$dca$sidebar_col, sass_file("www/scss/main.scss"))) }) - - if (isTRUE(dcc_config_react()$dca$use_compliance_dashboard)) { - shinyjs::show("dashboard-toggle-btn-container") - } dcWaiter("hide") dcWaiter("show", msg = paste0("Getting data. This may take a minute."), @@ -304,6 +300,10 @@ shinyServer(function(input, output, session) { shinyjs::hide(select = "li:nth-child(4)") shinyjs::hide(select = "li:nth-child(5)") shinyjs::hide(select = "li:nth-child(6)") + session$sendCustomMessage( + "compliance_dashboard", + dcc_config_react()$dca$use_compliance_dashboard + ) dcWaiter("hide") } @@ -486,7 +486,7 @@ shinyServer(function(input, output, session) { updateSelectInput(session, "header_dropdown_folder", choices = selected$folder()) }) - + observeEvent(data_list$files(), ignoreInit = TRUE, { warn_text <- NULL if (length(data_list$folders()) == 0) { diff --git a/ui.R b/ui.R index d7194580..e62af869 100644 --- a/ui.R +++ b/ui.R @@ -119,7 +119,11 @@ ui <- shinydashboardPlus::dashboardPage( tags$head( tags$style(sass(sass_file("www/scss/main.scss"))), singleton(includeScript("www/js/readCookie.js")), - tags$script(htmlwidgets::JS("setTimeout(function(){history.pushState({}, 'Data Curator', window.location.pathname);},2000);")) + tags$script(htmlwidgets::JS("setTimeout(function(){history.pushState({}, 'Data Curator', window.location.pathname);},2000);"), + "Shiny.addCustomMessageHandler('compliance_dashboard', function(x) { + Shiny.setInputValue('compliance_dashboard', x); + }); + ") ), uiOutput("sass"), # load dependencies @@ -207,7 +211,7 @@ ui <- shinydashboardPlus::dashboardPage( class = "btn-primary-color" ) ), - shinyjs::hidden(dashboardUI("dashboard")) + conditionalPanel("input.compliance_dashboard", dashboardUI("dashboard")) ), ), tabItem( From 05f103e489cc93c7be349dcfdfded97faade6779 Mon Sep 17 00:00:00 2001 From: afwillia Date: Wed, 14 Feb 2024 09:07:41 -0800 Subject: [PATCH 16/52] update rlang --- renv.lock | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/renv.lock b/renv.lock index 465387e6..4a81c6f1 100644 --- a/renv.lock +++ b/renv.lock @@ -942,14 +942,8 @@ }, "rlang": { "Package": "rlang", - "Version": "1.0.6", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "utils" - ], - "Hash": "4ed1f8336c8d52c3e750adcdc57228a7" + "Version": "1.1.3", + "Source": "Repository" }, "rmarkdown": { "Package": "rmarkdown", From 9c48feaf16ed1aa84d2ab3fb16c819aa364b2bb5 Mon Sep 17 00:00:00 2001 From: afwillia Date: Wed, 14 Feb 2024 09:08:59 -0800 Subject: [PATCH 17/52] use httr2 to perform syn get with retries --- R/synapse_rest_api.R | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/R/synapse_rest_api.R b/R/synapse_rest_api.R index 54da3cdb..f65e6001 100644 --- a/R/synapse_rest_api.R +++ b/R/synapse_rest_api.R @@ -54,21 +54,17 @@ synapse_is_certified <- function(url="https://repo-prod.prod.sagebase.org/repo/v #' @param auth Synapse PAT #' #' @export -synapse_get <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/entity/", +synapse_get <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/entity", id, auth) { if (is.null(id)) stop("id cannot be NULL") - req_url <- file.path(url, id) - req <- httr::GET(req_url, - httr::add_headers(Authorization=paste0("Bearer ", auth))) - - # Send error if unsuccessful query - status <- httr::http_status(req) - if (status$category != "Success") stop(status$message) - - cont <- httr::content(req) - dplyr::bind_rows(cont) - + req <- httr2::request(file.path(url, id)) + resp <- req |> + httr2::req_retry() |> + httr2::req_throttle(rate = 1) |> + httr2::req_headers(Authorization = sprintf("Bearer %s", auth)) |> + httr2::req_perform() + resp |> httr2::resp_body_json() } From 6f6bdf26a983e9a7b825beeecfa8c8675f7d12e6 Mon Sep 17 00:00:00 2001 From: afwillia Date: Wed, 14 Feb 2024 09:09:39 -0800 Subject: [PATCH 18/52] use httr2 to perform manifest download with retries --- R/schematic_rest_api.R | 31 ++++++++++++------------------- functions/schematic_rest_api.R | 31 ++++++++++++------------------- 2 files changed, 24 insertions(+), 38 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index 7e31e818..66817a4e 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -19,28 +19,21 @@ check_success <- function(x){ #' @returns a csv of the manifest #' @export manifest_download <- function(url = "http://localhost:3001/v1/manifest/download", access_token, manifest_id, as_json=TRUE, new_manifest_name=NULL) { - request <- httr::GET( - url = url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query = list( + + req <- httr2::request(url) + resp <- req |> + httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> + httr2::req_url_query( manifest_id = manifest_id, as_json = as_json, new_manifest_name = new_manifest_name - ) - ) - - check_success(request) - response <- httr::content(request, type = "text", encoding = "UTF-8") - response <- fromJSON(gsub('NaN', '"NA"', response)) - - # Output can have many NULL values which get dropped or cause errors. Set them to NA - # nullToNA <- function(x) { - # x[sapply(x, is.null)] <- NA - # return(x) - # } - # df <- do.call(rbind, lapply(response, rbind)) - # nullToNA(df) - response + ) |> + httr2::req_retry() |> + httr2::req_throttle(rate = 1) |> + httr2::req_perform() + resp |> httr2::resp_body_string() |> + gsub('NaN', '"NA"', x = _) |> + jsonlite::fromJSON() } #' schematic rest api to generate manifest diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index 7e31e818..66817a4e 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -19,28 +19,21 @@ check_success <- function(x){ #' @returns a csv of the manifest #' @export manifest_download <- function(url = "http://localhost:3001/v1/manifest/download", access_token, manifest_id, as_json=TRUE, new_manifest_name=NULL) { - request <- httr::GET( - url = url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query = list( + + req <- httr2::request(url) + resp <- req |> + httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> + httr2::req_url_query( manifest_id = manifest_id, as_json = as_json, new_manifest_name = new_manifest_name - ) - ) - - check_success(request) - response <- httr::content(request, type = "text", encoding = "UTF-8") - response <- fromJSON(gsub('NaN', '"NA"', response)) - - # Output can have many NULL values which get dropped or cause errors. Set them to NA - # nullToNA <- function(x) { - # x[sapply(x, is.null)] <- NA - # return(x) - # } - # df <- do.call(rbind, lapply(response, rbind)) - # nullToNA(df) - response + ) |> + httr2::req_retry() |> + httr2::req_throttle(rate = 1) |> + httr2::req_perform() + resp |> httr2::resp_body_string() |> + gsub('NaN', '"NA"', x = _) |> + jsonlite::fromJSON() } #' schematic rest api to generate manifest From 549da9adcd30ff158f6e707fe42b502f126331dc Mon Sep 17 00:00:00 2001 From: afwillia Date: Wed, 14 Feb 2024 09:10:51 -0800 Subject: [PATCH 19/52] for parallel processing, use available cores minus 1 --- global.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/global.R b/global.R index 846a01cb..5a1b4bfa 100644 --- a/global.R +++ b/global.R @@ -27,7 +27,7 @@ suppressPackageStartupMessages({ }) # Set up futures/promises for asynchronous calls -ncores <- availableCores() +ncores <- availableCores() - 1 message(sprintf("Available cores: %s", ncores)) plan(multicore, workers = ncores) From 715a28f7caf28e64be63b035f10f667bf1ea3aab Mon Sep 17 00:00:00 2001 From: afwillia Date: Wed, 14 Feb 2024 09:18:35 -0800 Subject: [PATCH 20/52] download manifests in parallel --- functions/dashboardFuns.R | 63 ++++++++++++++++++++------------------- 1 file changed, 33 insertions(+), 30 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index 709123ff..f0a1dda7 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -39,41 +39,44 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= ) cols <- setNames(rep("", length(cols)), cols) metadata <- bind_rows(cols)[0, ] - lapply(file_view$parentId, function(dataset) { + metadata_list <- parallel::mclapply(file_view$parentId, function(dataset) { # get manifest's synapse id(s) in each dataset folder manifest_ids <- file_view$id[file_view$parentId == dataset] # in case, multiple manifests exist in the same dataset - for (id in manifest_ids) { - if (schematic_api == "reticulate"){ - info <- syn$get(id) - manifest_info <<- append(manifest_info, info) - user <- syn$getUserProfile(info["properties"]["modifiedBy"])["userName"] - modified_user <<- append(modified_user, user) - } else if (schematic_api == "rest"){ - info <- synapse_get(id = id, auth = access_token) - manifest <- manifest_download( - url = file.path(api_uri, "v1/manifest/download"), - access_token = access_token, - manifest_id = info$id, - as_json = TRUE - ) - manifest_tempfile <- tempfile( - pattern = id, fileext = ".csv" - ) - readr::write_csv(manifest, manifest_tempfile) - - # refactor this not to write files but save in a object - #tmp_man <- tempfile() - info$Path <- manifest_tempfile - #write_csv(manifest, tmp_man) - manifest_dfs[[id]] <<- manifest - manifest_info <<- append(manifest_info, list(unlist(info))) - user <- synapse_user_profile(auth=access_token)[["userName"]] - modified_user <<- append(modified_user, user) - } + manifests <- parallel::mclapply(manifest_ids, function(id) { + if (schematic_api == "reticulate"){ + info <- syn$get(id) + manifest_info <<- append(manifest_info, info) + user <- syn$getUserProfile(info["properties"]["modifiedBy"])["userName"] + modified_user <<- append(modified_user, user) + } else if (schematic_api == "rest"){ + info <- synapse_get(id = id, auth = access_token) + manifest <- manifest_download( + url = file.path(api_uri, "v1/manifest/download"), + access_token = access_token, + manifest_id = info$id, + as_json = TRUE + ) + manifest_tempfile <- tempfile( + pattern = id, fileext = ".csv" + ) + readr::write_csv(manifest, manifest_tempfile) + # refactor this not to write files but save in a object + info$Path <- manifest_tempfile + list( + manifest_df = manifest, + manifest_info = info, + modified_user = info$modifiedBy + ) } - }) + }, mc.cores = ncores) + manifests + }, mc.cores = ncores) + + manifest_dfs <- lapply(seq_along(metadata_list), function(x) metadata_list[[x]][[1]]$manifest_df) + manifest_info <- lapply(seq_along(metadata_list), function(x) metadata_list[[x]][[1]]$manifest_info) + modified_user <- lapply(seq_along(metadata_list), function(x) metadata_list[[x]][[1]]$modified_user) manifest_info <- bind_rows(manifest_info) manifest_info <- unique(manifest_info) From 75a003f7d2a0edd2664d2439f78144e1e326b8a7 Mon Sep 17 00:00:00 2001 From: afwillia Date: Wed, 14 Feb 2024 10:01:24 -0800 Subject: [PATCH 21/52] add max retries to syn get and remove throttle --- R/synapse_rest_api.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/synapse_rest_api.R b/R/synapse_rest_api.R index f65e6001..e5956e62 100644 --- a/R/synapse_rest_api.R +++ b/R/synapse_rest_api.R @@ -60,8 +60,10 @@ synapse_get <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/entit if (is.null(id)) stop("id cannot be NULL") req <- httr2::request(file.path(url, id)) resp <- req |> - httr2::req_retry() |> - httr2::req_throttle(rate = 1) |> + httr2::req_retry( + max_tries = 5, + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + ) |> httr2::req_headers(Authorization = sprintf("Bearer %s", auth)) |> httr2::req_perform() resp |> httr2::resp_body_json() @@ -274,6 +276,6 @@ synapse_download_file_handle <- function(dataFileHandleId, id, auth, filepath=NU download_url <- httr::content(request) destfile <- ifelse(is.null(filepath), tempfile(), filepath) download.file(download_url, destfile) - if (is.null(filepath)) readr::read_csv(destfile) + if (is.null(filepath)) readr::read_csv(destfile, show_col_types = FALSE) } From cb88371575ae5d4367235ce5d8519f1e29cc55c3 Mon Sep 17 00:00:00 2001 From: afwillia Date: Wed, 14 Feb 2024 10:01:40 -0800 Subject: [PATCH 22/52] add max retries to manifest download and remove throttle --- R/schematic_rest_api.R | 8 +++++--- functions/schematic_rest_api.R | 8 +++++--- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index 66817a4e..6a58c426 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -28,8 +28,10 @@ manifest_download <- function(url = "http://localhost:3001/v1/manifest/download" as_json = as_json, new_manifest_name = new_manifest_name ) |> - httr2::req_retry() |> - httr2::req_throttle(rate = 1) |> + httr2::req_retry( + max_tries = 3, + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + ) |> httr2::req_perform() resp |> httr2::resp_body_string() |> gsub('NaN', '"NA"', x = _) |> @@ -343,7 +345,7 @@ get_asset_view_table <- function(url="http://localhost:3001/v1/storage/assets/ta if (return_type=="json") { return(list2DF(fromJSON(httr::content(req)))) } else { - csv <- readr::read_csv(httr::content(req)) + csv <- readr::read_csv(httr::content(req), show_col_types = FALSE) return(csv) } diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index 66817a4e..6a58c426 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -28,8 +28,10 @@ manifest_download <- function(url = "http://localhost:3001/v1/manifest/download" as_json = as_json, new_manifest_name = new_manifest_name ) |> - httr2::req_retry() |> - httr2::req_throttle(rate = 1) |> + httr2::req_retry( + max_tries = 3, + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + ) |> httr2::req_perform() resp |> httr2::resp_body_string() |> gsub('NaN', '"NA"', x = _) |> @@ -343,7 +345,7 @@ get_asset_view_table <- function(url="http://localhost:3001/v1/storage/assets/ta if (return_type=="json") { return(list2DF(fromJSON(httr::content(req)))) } else { - csv <- readr::read_csv(httr::content(req)) + csv <- readr::read_csv(httr::content(req), show_col_types = FALSE) return(csv) } From f45897185ae0325cbd1a3b2a0d20b8bbd5698347 Mon Sep 17 00:00:00 2001 From: afwillia Date: Wed, 14 Feb 2024 10:02:10 -0800 Subject: [PATCH 23/52] run dashboard validation in parallel --- functions/dashboardFuns.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index f0a1dda7..4635c05c 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -154,7 +154,7 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url if (nrow(metadata) == 0) { return(metadata) } - lapply(1:nrow(metadata), function(i) { + parallel::mclapply(1:nrow(metadata), function(i) { manifest <- metadata[i, ] if (is.na(manifest$Component)) { data.frame( @@ -195,7 +195,7 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url WarnMsg = if_else(is.null(clean_res$warning_msg[1]), "Valid", paste(clean_res$warning_msg[1], collapse = "; ")) ) } - }) %>% + }, mc.cores = ncores) %>% bind_rows() %>% cbind(metadata, .) # expand metadata with validation results } From 9cbb92fa452bfaa1839969bc57a3d79b36bb7544 Mon Sep 17 00:00:00 2001 From: afwillia Date: Wed, 14 Feb 2024 10:08:32 -0800 Subject: [PATCH 24/52] suppress column type message when reading manifests in dashboard --- functions/dashboardFuns.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index 4635c05c..467de970 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -108,7 +108,7 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= # extract manifest essential information for dashboard manifest_path <- info$Path # See above - don't read from file, read from object - manifest_df <- readr::read_csv(manifest_path) + manifest_df <- readr::read_csv(manifest_path, show_col_types = FALSE) #manifest_df <- manifest_dfs[[i]] # keep all manifests used for validation, even if it has invalid component value # if manifest doesn't have "Component" column, or empty, return NA for component From da6bcbfc277d0ace8839351c16621d95112efb65 Mon Sep 17 00:00:00 2001 From: afwillia Date: Thu, 15 Feb 2024 09:31:37 -0800 Subject: [PATCH 25/52] Use httr2 for schematic validate and model component endpoints --- R/schematic_rest_api.R | 89 ++++++++++++++++++---------------- functions/schematic_rest_api.R | 89 ++++++++++++++++++---------------- 2 files changed, 96 insertions(+), 82 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index 6a58c426..e999f6e8 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -137,47 +137,59 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", } if (is.null(json_str)) { - req <- httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view)), - body=list(file_name=httr::upload_file(file_name)) - ) + req <- httr2::request(url) + resp <- req %>% + httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> + httr2::req_url_query( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view + ) |> + httr2::req_body_multipart(file_name=curl::form_file(file_name)) |> + httr2::req_retry( + max_tries = 3, + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + ) |> + httr2::req_error(is_error = \(resp) FALSE) |> + httr2::req_perform() } else { - req <- httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view, - json_str = json_str)) - ) + req <- httr2::request(url) + resp <- req %>% + httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> + httr2::req_url_query( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view, + json_str = json_str + ) |> + httr2::req_retry( + max_tries = 3, + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + ) |> + httr2::req_error(is_error = \(resp) FALSE) |> + httr2::req_perform() } # Format server error in a way validationResult can handle - if (httr::http_error(req)) { + if (httr2::resp_is_error(resp)) { return( list( list( "errors" = list( Row = NA, Column = NA, Value = NA, Error = sprintf("Cannot validate manifest: %s", - httr::http_status(req)$message + httr2::resp_status_desc(resp) ) ) ) ) ) } - check_success(req) - annotation_status <- httr::content(req) - annotation_status + httr2::resp_body_json(resp) } @@ -231,22 +243,17 @@ model_component_requirements <- function(url="http://localhost:3001/v1/model/com schema_url, source_component, as_graph = FALSE) { - req <- httr::GET(url, - query = list( - schema_url = schema_url, - source_component = source_component, - as_graph = as_graph - )) - - check_success(req) - cont <- httr::content(req) - - if (inherits(cont, "xml_document")){ - err_msg <- xml2::xml_text(xml2::xml_child(cont, "head/title")) - stop(sprintf("%s", err_msg)) - } - - cont + req <- httr2::request(url) + resp <- req |> + httr2::req_url_query( + schema_url = schema_url, + source_component = source_component, + as_graph = as_graph + ) |> + httr2::req_retry(max_tries = 3) |> + httr2::req_perform() + resp |> + httr2::resp_body_json() } diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index 6a58c426..e999f6e8 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -137,47 +137,59 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", } if (is.null(json_str)) { - req <- httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view)), - body=list(file_name=httr::upload_file(file_name)) - ) + req <- httr2::request(url) + resp <- req %>% + httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> + httr2::req_url_query( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view + ) |> + httr2::req_body_multipart(file_name=curl::form_file(file_name)) |> + httr2::req_retry( + max_tries = 3, + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + ) |> + httr2::req_error(is_error = \(resp) FALSE) |> + httr2::req_perform() } else { - req <- httr::POST(url, - httr::add_headers(Authorization = sprintf("Bearer %s", access_token)), - query=flattenbody(list( - schema_url=schema_url, - data_type=data_type, - restrict_rules=restrict_rules, - project_scope = project_scope, - asset_view = asset_view, - json_str = json_str)) - ) + req <- httr2::request(url) + resp <- req %>% + httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> + httr2::req_url_query( + schema_url=schema_url, + data_type=data_type, + restrict_rules=restrict_rules, + project_scope = project_scope, + asset_view = asset_view, + json_str = json_str + ) |> + httr2::req_retry( + max_tries = 3, + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + ) |> + httr2::req_error(is_error = \(resp) FALSE) |> + httr2::req_perform() } # Format server error in a way validationResult can handle - if (httr::http_error(req)) { + if (httr2::resp_is_error(resp)) { return( list( list( "errors" = list( Row = NA, Column = NA, Value = NA, Error = sprintf("Cannot validate manifest: %s", - httr::http_status(req)$message + httr2::resp_status_desc(resp) ) ) ) ) ) } - check_success(req) - annotation_status <- httr::content(req) - annotation_status + httr2::resp_body_json(resp) } @@ -231,22 +243,17 @@ model_component_requirements <- function(url="http://localhost:3001/v1/model/com schema_url, source_component, as_graph = FALSE) { - req <- httr::GET(url, - query = list( - schema_url = schema_url, - source_component = source_component, - as_graph = as_graph - )) - - check_success(req) - cont <- httr::content(req) - - if (inherits(cont, "xml_document")){ - err_msg <- xml2::xml_text(xml2::xml_child(cont, "head/title")) - stop(sprintf("%s", err_msg)) - } - - cont + req <- httr2::request(url) + resp <- req |> + httr2::req_url_query( + schema_url = schema_url, + source_component = source_component, + as_graph = as_graph + ) |> + httr2::req_retry(max_tries = 3) |> + httr2::req_perform() + resp |> + httr2::resp_body_json() } From 2289448ac892f1b63a84aaf63bd5c2b5c99c1752 Mon Sep 17 00:00:00 2001 From: afwillia Date: Thu, 15 Feb 2024 09:33:32 -0800 Subject: [PATCH 26/52] Run dashboard validation in parallel --- functions/dashboardFuns.R | 63 +++++++++++++++++++++++---------------- 1 file changed, 38 insertions(+), 25 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index 467de970..32e2f9e4 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -154,7 +154,7 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url if (nrow(metadata) == 0) { return(metadata) } - parallel::mclapply(1:nrow(metadata), function(i) { + m2 <- parallel::mclapply(1:nrow(metadata), function(i) { manifest <- metadata[i, ] if (is.na(manifest$Component)) { data.frame( @@ -171,32 +171,45 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url WarnMsg = "'Component' is missing" ) } else { - validation_res <- switch(schematic_api, - reticulate = manifest_validate_py( - manifestPath = manifest$Path, - rootNode = manifest$Component, - restrict_rules = TRUE, # set true to disable great expectation - project_scope = project.scope - ), - rest = manifest_validate(url=file.path(api_uri, "v1/model/validate"), - data_type=manifest$Component, - schema_url = schema_url, - access_token = access_token, - file_name = manifest$Path) - ) - # clean validation res from schematicpy - clean_res <- validationResult(validation_res, manifest$Component, dashboard = TRUE) - - data.frame( - Result = clean_res$result, - # change wrong schema to out-of-date type - ErrorType = if_else(clean_res$error_type == "Wrong Schema", "Out of Date", clean_res$error_type), - errorMsg = if_else(is.null(clean_res$error_msg[1]), "Valid", paste(clean_res$error_msg[1], collapse="; ")), - WarnMsg = if_else(is.null(clean_res$warning_msg[1]), "Valid", paste(clean_res$warning_msg[1], collapse = "; ")) + validation_res <- tryCatch( + switch(schematic_api, + reticulate = manifest_validate_py( + manifestPath = manifest$Path, + rootNode = manifest$Component, + restrict_rules = TRUE, # set true to disable great expectation + project_scope = project.scope + ), + rest = manifest_validate(url=file.path(api_uri, "v1/model/validate"), + data_type=manifest$Component, + schema_url = schema_url, + access_token = access_token, + file_name = manifest$Path) + ), silent = TRUE ) + if (!inherits(validation_res, "try-error")) { + # clean validation res from schematicpy + clean_res <- validationResult(validation_res, manifest$Component, dashboard = TRUE) + + data.frame( + Result = clean_res$result, + # change wrong schema to out-of-date type + ErrorType = if_else(clean_res$error_type == "Wrong Schema", "Out of Date", clean_res$error_type), + errorMsg = if_else(is.null(clean_res$error_msg[1]), "Valid", paste(clean_res$error_msg[1], collapse="; ")), + WarnMsg = if_else(is.null(clean_res$warning_msg[1]), "Valid", paste(clean_res$warning_msg[1], collapse = "; ")) + ) + } else { + data.frame( + Result = "Fail", + # change wrong schema to out-of-date type + ErrorType = "Unknown Error", + errorMsg = "Server Error", + WarnMsg = " " + ) + } + } - }, mc.cores = ncores) %>% - bind_rows() %>% + }, mc.cores = ncores) + m2 <- bind_rows(m2) %>% cbind(metadata, .) # expand metadata with validation results } From a584e92a16879078126a4af97263462253218ab7 Mon Sep 17 00:00:00 2001 From: afwillia Date: Fri, 16 Feb 2024 09:36:20 -0800 Subject: [PATCH 27/52] Use anonymous function in pipe instead of _ to avoid R package build error --- R/schematic_rest_api.R | 6 +++--- functions/schematic_rest_api.R | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index e999f6e8..d4025ffd 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -34,7 +34,7 @@ manifest_download <- function(url = "http://localhost:3001/v1/manifest/download" ) |> httr2::req_perform() resp |> httr2::resp_body_string() |> - gsub('NaN', '"NA"', x = _) |> + (function(d) gsub('NaN', '"NA"', x = d))() |> jsonlite::fromJSON() } @@ -150,7 +150,7 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", httr2::req_body_multipart(file_name=curl::form_file(file_name)) |> httr2::req_retry( max_tries = 3, - is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 504) ) |> httr2::req_error(is_error = \(resp) FALSE) |> httr2::req_perform() @@ -168,7 +168,7 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", ) |> httr2::req_retry( max_tries = 3, - is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 504) ) |> httr2::req_error(is_error = \(resp) FALSE) |> httr2::req_perform() diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index e999f6e8..d4025ffd 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -34,7 +34,7 @@ manifest_download <- function(url = "http://localhost:3001/v1/manifest/download" ) |> httr2::req_perform() resp |> httr2::resp_body_string() |> - gsub('NaN', '"NA"', x = _) |> + (function(d) gsub('NaN', '"NA"', x = d))() |> jsonlite::fromJSON() } @@ -150,7 +150,7 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", httr2::req_body_multipart(file_name=curl::form_file(file_name)) |> httr2::req_retry( max_tries = 3, - is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 504) ) |> httr2::req_error(is_error = \(resp) FALSE) |> httr2::req_perform() @@ -168,7 +168,7 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", ) |> httr2::req_retry( max_tries = 3, - is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 504) ) |> httr2::req_error(is_error = \(resp) FALSE) |> httr2::req_perform() From f0446dd0b1dae4539867597ce1794e8a0a8455f6 Mon Sep 17 00:00:00 2001 From: afwillia Date: Mon, 19 Feb 2024 09:23:28 -0800 Subject: [PATCH 28/52] Add test output to validate function --- R/schematic_rest_api.R | 41 ++++++++++++++++++++-------------- functions/schematic_rest_api.R | 41 ++++++++++++++++++++-------------- 2 files changed, 48 insertions(+), 34 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index d4025ffd..570af6e8 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -112,7 +112,8 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", schema_url="https://raw.githubusercontent.com/ncihtan/data-models/main/HTAN.model.jsonld", #nolint data_type, file_name = NULL, restrict_rules=FALSE, project_scope = NULL, access_token, asset_view = NULL, json_str = NULL) { - + a <- paste0(sample(1000, 1), "-") + cat(paste0(a, "-validate func ", data_type, " ", file_name, "\n")) flattenbody <- function(x) { # A form/query can only have one value per name, so take # any values that contain vectors length >1 and @@ -137,8 +138,15 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", } if (is.null(json_str)) { - req <- httr2::request(url) - resp <- req %>% + reqs <- httr2::request(url) |> + httr2::req_retry( + max_tries = 3, + is_transient = \(reqs) httr2::resp_status(reqs) %in% c(429, 500, 503, 504) + ) |> + httr2::req_error(is_error = \(reqs) FALSE) |> + httr2::req_throttle(1) + cat(paste0(a, "-validate func requesting", unlist(reqs), "\n")) + resp <- reqs %>% httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( schema_url=schema_url, @@ -148,14 +156,11 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", asset_view = asset_view ) |> httr2::req_body_multipart(file_name=curl::form_file(file_name)) |> - httr2::req_retry( - max_tries = 3, - is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 504) - ) |> - httr2::req_error(is_error = \(resp) FALSE) |> httr2::req_perform() + cat(paste0(a, "-validate func response", unlist(resp), "\n")) } else { - req <- httr2::request(url) + req <- httr2::request(url) |> + httr2::req_throttle(1) resp <- req %>% httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( @@ -166,15 +171,16 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", asset_view = asset_view, json_str = json_str ) |> - httr2::req_retry( - max_tries = 3, - is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 504) - ) |> - httr2::req_error(is_error = \(resp) FALSE) |> + #httr2::req_retry( + # max_tries = 3, + # is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 504) + #) |> + #httr2::req_error(is_error = \(resp) FALSE) |> httr2::req_perform() } # Format server error in a way validationResult can handle + cat(a, "-validate func response", "\n") if (httr2::resp_is_error(resp)) { return( list( @@ -243,14 +249,15 @@ model_component_requirements <- function(url="http://localhost:3001/v1/model/com schema_url, source_component, as_graph = FALSE) { - req <- httr2::request(url) - resp <- req |> + reqs <- httr2::request(url) |> + httr2::req_throttle(1) + resp <- reqs |> httr2::req_url_query( schema_url = schema_url, source_component = source_component, as_graph = as_graph ) |> - httr2::req_retry(max_tries = 3) |> + #httr2::req_retry(max_tries = 3) |> httr2::req_perform() resp |> httr2::resp_body_json() diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index d4025ffd..570af6e8 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -112,7 +112,8 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", schema_url="https://raw.githubusercontent.com/ncihtan/data-models/main/HTAN.model.jsonld", #nolint data_type, file_name = NULL, restrict_rules=FALSE, project_scope = NULL, access_token, asset_view = NULL, json_str = NULL) { - + a <- paste0(sample(1000, 1), "-") + cat(paste0(a, "-validate func ", data_type, " ", file_name, "\n")) flattenbody <- function(x) { # A form/query can only have one value per name, so take # any values that contain vectors length >1 and @@ -137,8 +138,15 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", } if (is.null(json_str)) { - req <- httr2::request(url) - resp <- req %>% + reqs <- httr2::request(url) |> + httr2::req_retry( + max_tries = 3, + is_transient = \(reqs) httr2::resp_status(reqs) %in% c(429, 500, 503, 504) + ) |> + httr2::req_error(is_error = \(reqs) FALSE) |> + httr2::req_throttle(1) + cat(paste0(a, "-validate func requesting", unlist(reqs), "\n")) + resp <- reqs %>% httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( schema_url=schema_url, @@ -148,14 +156,11 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", asset_view = asset_view ) |> httr2::req_body_multipart(file_name=curl::form_file(file_name)) |> - httr2::req_retry( - max_tries = 3, - is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 504) - ) |> - httr2::req_error(is_error = \(resp) FALSE) |> httr2::req_perform() + cat(paste0(a, "-validate func response", unlist(resp), "\n")) } else { - req <- httr2::request(url) + req <- httr2::request(url) |> + httr2::req_throttle(1) resp <- req %>% httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( @@ -166,15 +171,16 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", asset_view = asset_view, json_str = json_str ) |> - httr2::req_retry( - max_tries = 3, - is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 504) - ) |> - httr2::req_error(is_error = \(resp) FALSE) |> + #httr2::req_retry( + # max_tries = 3, + # is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 504) + #) |> + #httr2::req_error(is_error = \(resp) FALSE) |> httr2::req_perform() } # Format server error in a way validationResult can handle + cat(a, "-validate func response", "\n") if (httr2::resp_is_error(resp)) { return( list( @@ -243,14 +249,15 @@ model_component_requirements <- function(url="http://localhost:3001/v1/model/com schema_url, source_component, as_graph = FALSE) { - req <- httr2::request(url) - resp <- req |> + reqs <- httr2::request(url) |> + httr2::req_throttle(1) + resp <- reqs |> httr2::req_url_query( schema_url = schema_url, source_component = source_component, as_graph = as_graph ) |> - httr2::req_retry(max_tries = 3) |> + #httr2::req_retry(max_tries = 3) |> httr2::req_perform() resp |> httr2::resp_body_json() From 8cde1357e5eb82aea5186dee6ad608fc01a44ead Mon Sep 17 00:00:00 2001 From: afwillia Date: Mon, 19 Feb 2024 09:24:03 -0800 Subject: [PATCH 29/52] Hard code schematic endpoint in dashboard --- modules/dashboard/dashboard.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/dashboard/dashboard.R b/modules/dashboard/dashboard.R index d5c0cb15..387715ee 100644 --- a/modules/dashboard/dashboard.R +++ b/modules/dashboard/dashboard.R @@ -94,7 +94,7 @@ dashboard <- function(id, syn.store, project.scope, schema, schema.display.name, # get all datasets from selected project folder_list <- switch(schematic_api, - "rest" = storage_project_datasets(url=file.path(api_uri, "v1/storage/project/datasets"), + "rest" = storage_project_datasets(url=file.path("https://schematic-dev.api.sagebionetworks.org/v1/storage/project/datasets"), asset_view = fileview, project_id=folder, access_token=access_token), @@ -123,7 +123,7 @@ dashboard <- function(id, syn.store, project.scope, schema, schema.display.name, selected_datatype_requirement <- eventReactive(c(schema(), input$box$visible), { req(input$box$visible) get_schema_nodes(schema(), schematic_api = schematic_api, - url=file.path(api_uri, "v1/model/component-requirements"), + url=file.path("https://schematic-dev.api.sagebionetworks.org/v1/model/component-requirements"), schema_url = schema_url) }) @@ -134,7 +134,7 @@ dashboard <- function(id, syn.store, project.scope, schema, schema.display.name, # remove rows with invalid component name metadata <- uploaded_manifests() %>% filter(!is.na(Component), Component != "Unknown") get_metadata_nodes(metadata, ncores = ncores, schematic_api=schematic_api, - schema_url = schema_url, url = file.path(api_uri, "v1/model/component-requirements")) + schema_url = schema_url, url = file.path("https://schematic-dev.api.sagebionetworks.org/v1/model/component-requirements")) }) # render info/plots for selected datatype From 8a867faa81dc0f50f1b3cae52ce658aa54c23486 Mon Sep 17 00:00:00 2001 From: afwillia Date: Mon, 19 Feb 2024 09:24:46 -0800 Subject: [PATCH 30/52] Add messaging to validation function. Run serially. --- functions/dashboardFuns.R | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index 32e2f9e4..83feed95 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -11,7 +11,7 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= # get data for all manifests within the specified datasets file_view <- switch(schematic_api, reticulate = syn.store$storageFileviewTable, - rest = get_asset_view_table(url = file.path(api_uri, "v1/storage/assets/tables"), + rest = get_asset_view_table(url = file.path("https://schematic-dev.api.sagebionetworks.org/v1/storage/assets/tables"), access_token = access_token, asset_view=fileview) ) %>% @@ -58,7 +58,7 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= as_json = TRUE ) manifest_tempfile <- tempfile( - pattern = id, fileext = ".csv" + pattern = paste0(id, Sys.getpid()), fileext = ".csv" ) readr::write_csv(manifest, manifest_tempfile) @@ -154,8 +154,9 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url if (nrow(metadata) == 0) { return(metadata) } - m2 <- parallel::mclapply(1:nrow(metadata), function(i) { + m2 <- lapply(1:nrow(metadata), function(i) { manifest <- metadata[i, ] + cat(paste0("validating ", manifest$Path, "\n")) if (is.na(manifest$Component)) { data.frame( Result = "invalid", @@ -171,7 +172,7 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url WarnMsg = "'Component' is missing" ) } else { - validation_res <- tryCatch( + validation_res <- switch(schematic_api, reticulate = manifest_validate_py( manifestPath = manifest$Path, @@ -179,17 +180,21 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url restrict_rules = TRUE, # set true to disable great expectation project_scope = project.scope ), - rest = manifest_validate(url=file.path(api_uri, "v1/model/validate"), + rest = manifest_validate(url=file.path("https://schematic-dev.api.sagebionetworks.org/v1/model/validate"), data_type=manifest$Component, schema_url = schema_url, access_token = access_token, file_name = manifest$Path) - ), silent = TRUE ) + cat(paste0(unlist(validation_res), "\n")) if (!inherits(validation_res, "try-error")) { # clean validation res from schematicpy clean_res <- validationResult(validation_res, manifest$Component, dashboard = TRUE) - + cat("iteration ", i, " : ", unlist(clean_res), "\n") + clean_res[which(sapply(clean_res, is.null))] <- NA + if (grepl("Cannot validate manifest", clean_res$error_msg[[1]])) { + clean_res <- bind_cols(clean_res) + } data.frame( Result = clean_res$result, # change wrong schema to out-of-date type @@ -208,7 +213,7 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url } } - }, mc.cores = ncores) + }, mc.cores = 1) m2 <- bind_rows(m2) %>% cbind(metadata, .) # expand metadata with validation results } @@ -234,7 +239,7 @@ get_schema_nodes <- function(schema, schematic_api, url, schema_url) { if (length(requirement) == 0) { # return data type itself without name - return(as.character(schema)) + return(schema=as.character(schema)) } else { # return a list of requirements of the data type return(list2Vector(requirement)) @@ -268,7 +273,6 @@ get_metadata_nodes <- function(metadata, ncores = 1, schematic_api, return(list()) } ) %>% list2Vector() - source <- as.character(nodes) target <- names(nodes) From bd6cafa76a1db747bdbdb2a79e3fb76f2364b1cb Mon Sep 17 00:00:00 2001 From: afwillia Date: Mon, 19 Feb 2024 10:51:11 -0800 Subject: [PATCH 31/52] add schematic and venv to Rbuildignore --- .Rbuildignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.Rbuildignore b/.Rbuildignore index dcae32c1..bf1de74f 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,3 +1,5 @@ ^\.pre-commit-config\.yaml$ ^renv$ ^renv\.lock$ +^.venv +^schematic$ \ No newline at end of file From c33b0c394b1a79d2c127cd83fa26e29205d81165 Mon Sep 17 00:00:00 2001 From: afwillia Date: Mon, 19 Feb 2024 11:02:57 -0800 Subject: [PATCH 32/52] remove debugging messages from manifest_validate --- R/schematic_rest_api.R | 4 ---- functions/schematic_rest_api.R | 4 ---- 2 files changed, 8 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index 570af6e8..3200ddd5 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -113,7 +113,6 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", data_type, file_name = NULL, restrict_rules=FALSE, project_scope = NULL, access_token, asset_view = NULL, json_str = NULL) { a <- paste0(sample(1000, 1), "-") - cat(paste0(a, "-validate func ", data_type, " ", file_name, "\n")) flattenbody <- function(x) { # A form/query can only have one value per name, so take # any values that contain vectors length >1 and @@ -145,7 +144,6 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", ) |> httr2::req_error(is_error = \(reqs) FALSE) |> httr2::req_throttle(1) - cat(paste0(a, "-validate func requesting", unlist(reqs), "\n")) resp <- reqs %>% httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( @@ -157,7 +155,6 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", ) |> httr2::req_body_multipart(file_name=curl::form_file(file_name)) |> httr2::req_perform() - cat(paste0(a, "-validate func response", unlist(resp), "\n")) } else { req <- httr2::request(url) |> httr2::req_throttle(1) @@ -180,7 +177,6 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", } # Format server error in a way validationResult can handle - cat(a, "-validate func response", "\n") if (httr2::resp_is_error(resp)) { return( list( diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index 570af6e8..3200ddd5 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -113,7 +113,6 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", data_type, file_name = NULL, restrict_rules=FALSE, project_scope = NULL, access_token, asset_view = NULL, json_str = NULL) { a <- paste0(sample(1000, 1), "-") - cat(paste0(a, "-validate func ", data_type, " ", file_name, "\n")) flattenbody <- function(x) { # A form/query can only have one value per name, so take # any values that contain vectors length >1 and @@ -145,7 +144,6 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", ) |> httr2::req_error(is_error = \(reqs) FALSE) |> httr2::req_throttle(1) - cat(paste0(a, "-validate func requesting", unlist(reqs), "\n")) resp <- reqs %>% httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( @@ -157,7 +155,6 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", ) |> httr2::req_body_multipart(file_name=curl::form_file(file_name)) |> httr2::req_perform() - cat(paste0(a, "-validate func response", unlist(resp), "\n")) } else { req <- httr2::request(url) |> httr2::req_throttle(1) @@ -180,7 +177,6 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", } # Format server error in a way validationResult can handle - cat(a, "-validate func response", "\n") if (httr2::resp_is_error(resp)) { return( list( From 1083faa7521c3725edf3ce35fec7f31fb50e19fd Mon Sep 17 00:00:00 2001 From: afwillia Date: Mon, 19 Feb 2024 11:03:07 -0800 Subject: [PATCH 33/52] Add httr2 to renv.lock --- renv.lock | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/renv.lock b/renv.lock index 4a81c6f1..0ea6f44b 100644 --- a/renv.lock +++ b/renv.lock @@ -555,6 +555,11 @@ ], "Hash": "f6844033201269bec3ca0097bc6c97b3" }, + "httr2": { + "Package": "httr2", + "Version": "1.0.0", + "Source": "Repository" + }, "igraph": { "Package": "igraph", "Version": "1.4.1", From 64fd3a4177b8d48c8be2f706e0064c31318ed32f Mon Sep 17 00:00:00 2001 From: afwillia Date: Mon, 19 Feb 2024 11:03:20 -0800 Subject: [PATCH 34/52] Use mclapply with 1 core for validate --- functions/dashboardFuns.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index 83feed95..7221decc 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -154,7 +154,7 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url if (nrow(metadata) == 0) { return(metadata) } - m2 <- lapply(1:nrow(metadata), function(i) { + m2 <- parallel::mclapply(1:nrow(metadata), function(i) { manifest <- metadata[i, ] cat(paste0("validating ", manifest$Path, "\n")) if (is.na(manifest$Component)) { From a98cb4787fe1c971c468200c0616a2cd521083ff Mon Sep 17 00:00:00 2001 From: afwillia Date: Tue, 20 Feb 2024 07:36:28 -0800 Subject: [PATCH 35/52] Remove cat() debugging statements in dashboard --- functions/dashboardFuns.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index 7221decc..be6c6c5d 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -156,7 +156,6 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url } m2 <- parallel::mclapply(1:nrow(metadata), function(i) { manifest <- metadata[i, ] - cat(paste0("validating ", manifest$Path, "\n")) if (is.na(manifest$Component)) { data.frame( Result = "invalid", @@ -186,11 +185,9 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url access_token = access_token, file_name = manifest$Path) ) - cat(paste0(unlist(validation_res), "\n")) if (!inherits(validation_res, "try-error")) { # clean validation res from schematicpy clean_res <- validationResult(validation_res, manifest$Component, dashboard = TRUE) - cat("iteration ", i, " : ", unlist(clean_res), "\n") clean_res[which(sapply(clean_res, is.null))] <- NA if (grepl("Cannot validate manifest", clean_res$error_msg[[1]])) { clean_res <- bind_cols(clean_res) From a654407d41a11432953f7b3683a299fc7a6d69e7 Mon Sep 17 00:00:00 2001 From: afwillia Date: Tue, 20 Feb 2024 07:44:51 -0800 Subject: [PATCH 36/52] Use shiny-base release-1.9 --- Dockerfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Dockerfile b/Dockerfile index 454198a0..e444fe18 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,4 +1,4 @@ -FROM ghcr.io/afwillia/shiny-base:release-1.8 +FROM ghcr.io/afwillia/shiny-base:release-1.9 # add version tag as a build argument ARG DCA_VERSION From a535183a5bf6e7fa4d651846dda7de80eceb1447 Mon Sep 17 00:00:00 2001 From: afwillia Date: Tue, 20 Feb 2024 08:37:18 -0800 Subject: [PATCH 37/52] Don't run dashboard in parallel --- functions/dashboardFuns.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index be6c6c5d..3171c9aa 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -70,9 +70,9 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= modified_user = info$modifiedBy ) } - }, mc.cores = ncores) + }, mc.cores = 1) manifests - }, mc.cores = ncores) + }, mc.cores = 1) manifest_dfs <- lapply(seq_along(metadata_list), function(x) metadata_list[[x]][[1]]$manifest_df) manifest_info <- lapply(seq_along(metadata_list), function(x) metadata_list[[x]][[1]]$manifest_info) @@ -122,12 +122,12 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= ModifiedOn = info$modifiedOn, ModifiedUser = paste0("@", modified_user[[i]]), Path = manifest_path, - Folder = names(datasets)[which(datasets == info$parentId)], + Folder = names(datasets)[which(datasets %in% info$parentId)], FolderSynId = info$parentId, manifest = list(manifest_df) ) } - }, mc.cores = ncores) %>% bind_rows() + }, mc.cores = 1) %>% bind_rows() } # add empty dataset ids even if there are no manifests @@ -284,7 +284,7 @@ get_metadata_nodes <- function(metadata, ncores = 1, schematic_api, folder_id = c(manifest$FolderSynId), n_miss = c(n_miss) ) - }, mc.cores = ncores) %>% bind_rows() + }, mc.cores = 1) %>% bind_rows() } } From 829ae32cd1318fa99d90a340825e08ed85949098 Mon Sep 17 00:00:00 2001 From: afwillia Date: Tue, 20 Feb 2024 09:13:14 -0800 Subject: [PATCH 38/52] Edit error handling for manifest download --- R/schematic_rest_api.R | 22 +++++++++++++--------- functions/schematic_rest_api.R | 22 +++++++++++++--------- 2 files changed, 26 insertions(+), 18 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index 3200ddd5..c2573c84 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -20,7 +20,12 @@ check_success <- function(x){ #' @export manifest_download <- function(url = "http://localhost:3001/v1/manifest/download", access_token, manifest_id, as_json=TRUE, new_manifest_name=NULL) { - req <- httr2::request(url) + req <- httr2::request(url) |> + httr2::req_retry( + max_tries = 3, + is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503) + ) |> + httr2::req_error(is_error = \(r) FALSE) resp <- req |> httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( @@ -28,10 +33,6 @@ manifest_download <- function(url = "http://localhost:3001/v1/manifest/download" as_json = as_json, new_manifest_name = new_manifest_name ) |> - httr2::req_retry( - max_tries = 3, - is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) - ) |> httr2::req_perform() resp |> httr2::resp_body_string() |> (function(d) gsub('NaN', '"NA"', x = d))() |> @@ -140,10 +141,9 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", reqs <- httr2::request(url) |> httr2::req_retry( max_tries = 3, - is_transient = \(reqs) httr2::resp_status(reqs) %in% c(429, 500, 503, 504) + is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 504) ) |> - httr2::req_error(is_error = \(reqs) FALSE) |> - httr2::req_throttle(1) + httr2::req_error(is_error = \(reqs) FALSE) resp <- reqs %>% httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( @@ -246,7 +246,11 @@ model_component_requirements <- function(url="http://localhost:3001/v1/model/com as_graph = FALSE) { reqs <- httr2::request(url) |> - httr2::req_throttle(1) + httr2::req_retry( + max_tries = 3, + is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503) + ) |> + httr2::req_error(is_error = \(r) FALSE) resp <- reqs |> httr2::req_url_query( schema_url = schema_url, diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index 3200ddd5..c2573c84 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -20,7 +20,12 @@ check_success <- function(x){ #' @export manifest_download <- function(url = "http://localhost:3001/v1/manifest/download", access_token, manifest_id, as_json=TRUE, new_manifest_name=NULL) { - req <- httr2::request(url) + req <- httr2::request(url) |> + httr2::req_retry( + max_tries = 3, + is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503) + ) |> + httr2::req_error(is_error = \(r) FALSE) resp <- req |> httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( @@ -28,10 +33,6 @@ manifest_download <- function(url = "http://localhost:3001/v1/manifest/download" as_json = as_json, new_manifest_name = new_manifest_name ) |> - httr2::req_retry( - max_tries = 3, - is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) - ) |> httr2::req_perform() resp |> httr2::resp_body_string() |> (function(d) gsub('NaN', '"NA"', x = d))() |> @@ -140,10 +141,9 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", reqs <- httr2::request(url) |> httr2::req_retry( max_tries = 3, - is_transient = \(reqs) httr2::resp_status(reqs) %in% c(429, 500, 503, 504) + is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 504) ) |> - httr2::req_error(is_error = \(reqs) FALSE) |> - httr2::req_throttle(1) + httr2::req_error(is_error = \(reqs) FALSE) resp <- reqs %>% httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( @@ -246,7 +246,11 @@ model_component_requirements <- function(url="http://localhost:3001/v1/model/com as_graph = FALSE) { reqs <- httr2::request(url) |> - httr2::req_throttle(1) + httr2::req_retry( + max_tries = 3, + is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503) + ) |> + httr2::req_error(is_error = \(r) FALSE) resp <- reqs |> httr2::req_url_query( schema_url = schema_url, From 94f1d21ce343dba64195b17528f07ceb4870dd54 Mon Sep 17 00:00:00 2001 From: afwillia Date: Tue, 20 Feb 2024 09:13:36 -0800 Subject: [PATCH 39/52] Download manifests in parallel --- functions/dashboardFuns.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index 3171c9aa..bc076aea 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -70,9 +70,9 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= modified_user = info$modifiedBy ) } - }, mc.cores = 1) + }, mc.cores = ncores) manifests - }, mc.cores = 1) + }, mc.cores = ncores) manifest_dfs <- lapply(seq_along(metadata_list), function(x) metadata_list[[x]][[1]]$manifest_df) manifest_info <- lapply(seq_along(metadata_list), function(x) metadata_list[[x]][[1]]$manifest_info) @@ -127,7 +127,7 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= manifest = list(manifest_df) ) } - }, mc.cores = 1) %>% bind_rows() + }, mc.cores = ncores) %>% bind_rows() } # add empty dataset ids even if there are no manifests @@ -284,7 +284,7 @@ get_metadata_nodes <- function(metadata, ncores = 1, schematic_api, folder_id = c(manifest$FolderSynId), n_miss = c(n_miss) ) - }, mc.cores = 1) %>% bind_rows() + }, mc.cores = ncores) %>% bind_rows() } } From bb54db57069ecdaecc0f84b8eeccb09c3e1810d1 Mon Sep 17 00:00:00 2001 From: afwillia Date: Tue, 20 Feb 2024 09:13:55 -0800 Subject: [PATCH 40/52] Use rlang backtrace for errors --- global.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/global.R b/global.R index 5a1b4bfa..226387bf 100644 --- a/global.R +++ b/global.R @@ -32,6 +32,10 @@ message(sprintf("Available cores: %s", ncores)) plan(multicore, workers = ncores) options(shiny.maxRequestSize=32*1024^2) +options( + rlang_backtrace_on_error = "branch", + error = rlang::entrace +) # import R files source_files <- list.files(c("functions", "modules"), pattern = "*\\.R$", recursive = TRUE, full.names = TRUE) From 80115b6ae9880ac4a87e5225d2e5352c93b54b2e Mon Sep 17 00:00:00 2001 From: afwillia Date: Tue, 20 Feb 2024 13:27:38 -0800 Subject: [PATCH 41/52] Add options to one statement --- global.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/global.R b/global.R index 226387bf..2e17e23d 100644 --- a/global.R +++ b/global.R @@ -31,8 +31,8 @@ ncores <- availableCores() - 1 message(sprintf("Available cores: %s", ncores)) plan(multicore, workers = ncores) -options(shiny.maxRequestSize=32*1024^2) options( + shiny.maxRequestSize=32*1024^2, rlang_backtrace_on_error = "branch", error = rlang::entrace ) From 1cfe29282f7792f0a359486267c694a4238178a4 Mon Sep 17 00:00:00 2001 From: afwillia Date: Tue, 20 Feb 2024 13:28:05 -0800 Subject: [PATCH 42/52] Add more error handling to model_component_requirements --- functions/dashboardFuns.R | 34 +++++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 11 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index bc076aea..6880a45b 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -14,8 +14,8 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= rest = get_asset_view_table(url = file.path("https://schematic-dev.api.sagebionetworks.org/v1/storage/assets/tables"), access_token = access_token, asset_view=fileview) - ) %>% - filter(grepl("synapse_storage_manifest_", name) & parentId %in% datasets) + ) + file_view <- filter(file_view, grepl("synapse_storage_manifest_", name) & parentId %in% datasets) # datasets don't have a manifest ds_no_manifest <- datasets[which(!datasets %in% file_view$parentId)] @@ -122,12 +122,13 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= ModifiedOn = info$modifiedOn, ModifiedUser = paste0("@", modified_user[[i]]), Path = manifest_path, - Folder = names(datasets)[which(datasets %in% info$parentId)], + Folder = names(datasets)[which(datasets == info$parentId)], FolderSynId = info$parentId, manifest = list(manifest_df) ) } - }, mc.cores = ncores) %>% bind_rows() + }, mc.cores = ncores) + metadata <- bind_rows(metadata) } # add empty dataset ids even if there are no manifests @@ -187,6 +188,13 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url ) if (!inherits(validation_res, "try-error")) { # clean validation res from schematicpy + if (!length(validation_res) == 2) { + validation_res <- list(list( + "errors" = list( + Row = NA, Column = NA, Value = NA, + Error = "Cannot validate manifest" + ))) + } clean_res <- validationResult(validation_res, manifest$Component, dashboard = TRUE) clean_res[which(sapply(clean_res, is.null))] <- NA if (grepl("Cannot validate manifest", clean_res$error_msg[[1]])) { @@ -210,9 +218,9 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url } } - }, mc.cores = 1) - m2 <- bind_rows(m2) %>% - cbind(metadata, .) # expand metadata with validation results + }, mc.cores = ncores) + m2 <- bind_rows(m2) + cbind(metadata, m2) # expand metadata with validation results } #' create a list of requirements for selected data type @@ -233,7 +241,7 @@ get_schema_nodes <- function(schema, schematic_api, url, schema_url) { return(list()) } ) - + if ("status" %in% names(requirement)) return(schema=as.character(schema)) if (length(requirement) == 0) { # return data type itself without name return(schema=as.character(schema)) @@ -253,7 +261,7 @@ get_metadata_nodes <- function(metadata, ncores = 1, schematic_api, if (nrow(metadata) == 0) { return(data.frame(from = NA, to = NA, folder = NA, folderSynId = NA, nMiss = NA)) } else { - parallel::mclapply(1:nrow(metadata), function(i) { + mn <- parallel::mclapply(1:nrow(metadata), function(i) { manifest <- metadata[i, ] # get all required data types nodes <- tryCatch( @@ -267,9 +275,12 @@ get_metadata_nodes <- function(metadata, ncores = 1, schematic_api, ), error = function(e) { warning("'get_metadata_nodes' failed: ", sQuote(manifest$Component), ":\n", e$message) + cat(paste0("'get_metadata_nodes' failed: ", sQuote(manifest$Component), ":\n", e$message)) return(list()) } - ) %>% list2Vector() + ) + if ("status" %in% names(nodes)) nodes <- list() + nodes <- list2Vector(nodes) source <- as.character(nodes) target <- names(nodes) @@ -284,7 +295,8 @@ get_metadata_nodes <- function(metadata, ncores = 1, schematic_api, folder_id = c(manifest$FolderSynId), n_miss = c(n_miss) ) - }, mc.cores = ncores) %>% bind_rows() + }, mc.cores = ncores) + mn <- bind_rows(mn) } } From 406050976b98e6da4b0dda6ee577fd9a89d12c6d Mon Sep 17 00:00:00 2001 From: afwillia Date: Tue, 20 Feb 2024 13:28:36 -0800 Subject: [PATCH 43/52] Remove error handling from API wrapper functions, put in other functions --- R/schematic_rest_api.R | 29 ++++++++++++++--------------- functions/schematic_rest_api.R | 29 ++++++++++++++--------------- 2 files changed, 28 insertions(+), 30 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index c2573c84..ad317c57 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -113,7 +113,6 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", schema_url="https://raw.githubusercontent.com/ncihtan/data-models/main/HTAN.model.jsonld", #nolint data_type, file_name = NULL, restrict_rules=FALSE, project_scope = NULL, access_token, asset_view = NULL, json_str = NULL) { - a <- paste0(sample(1000, 1), "-") flattenbody <- function(x) { # A form/query can only have one value per name, so take # any values that contain vectors length >1 and @@ -177,20 +176,20 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", } # Format server error in a way validationResult can handle - if (httr2::resp_is_error(resp)) { - return( - list( - list( - "errors" = list( - Row = NA, Column = NA, Value = NA, - Error = sprintf("Cannot validate manifest: %s", - httr2::resp_status_desc(resp) - ) - ) - ) - ) - ) - } + # if (httr2::resp_is_error(resp)) { + # return( + # list( + # list( + # "errors" = list( + # Row = NA, Column = NA, Value = NA, + # Error = sprintf("Cannot validate manifest: %s", + # httr2::resp_status_desc(resp) + # ) + # ) + # ) + # ) + # ) + # } httr2::resp_body_json(resp) } diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index c2573c84..ad317c57 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -113,7 +113,6 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", schema_url="https://raw.githubusercontent.com/ncihtan/data-models/main/HTAN.model.jsonld", #nolint data_type, file_name = NULL, restrict_rules=FALSE, project_scope = NULL, access_token, asset_view = NULL, json_str = NULL) { - a <- paste0(sample(1000, 1), "-") flattenbody <- function(x) { # A form/query can only have one value per name, so take # any values that contain vectors length >1 and @@ -177,20 +176,20 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", } # Format server error in a way validationResult can handle - if (httr2::resp_is_error(resp)) { - return( - list( - list( - "errors" = list( - Row = NA, Column = NA, Value = NA, - Error = sprintf("Cannot validate manifest: %s", - httr2::resp_status_desc(resp) - ) - ) - ) - ) - ) - } + # if (httr2::resp_is_error(resp)) { + # return( + # list( + # list( + # "errors" = list( + # Row = NA, Column = NA, Value = NA, + # Error = sprintf("Cannot validate manifest: %s", + # httr2::resp_status_desc(resp) + # ) + # ) + # ) + # ) + # ) + # } httr2::resp_body_json(resp) } From 3e28afb81b38305603e2e1441693bd3df3a147c1 Mon Sep 17 00:00:00 2001 From: afwillia Date: Wed, 21 Feb 2024 09:08:22 -0800 Subject: [PATCH 44/52] Update how validate and component manifest return errors --- R/schematic_rest_api.R | 11 ++++++++--- functions/schematic_rest_api.R | 11 ++++++++--- 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index ad317c57..9d52915e 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -143,7 +143,7 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 504) ) |> httr2::req_error(is_error = \(reqs) FALSE) - resp <- reqs %>% + resp <- reqs |> httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( schema_url=schema_url, @@ -157,7 +157,7 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", } else { req <- httr2::request(url) |> httr2::req_throttle(1) - resp <- req %>% + resp <- req |> httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( schema_url=schema_url, @@ -246,7 +246,7 @@ model_component_requirements <- function(url="http://localhost:3001/v1/model/com reqs <- httr2::request(url) |> httr2::req_retry( - max_tries = 3, + max_tries = 5, is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503) ) |> httr2::req_error(is_error = \(r) FALSE) @@ -258,6 +258,11 @@ model_component_requirements <- function(url="http://localhost:3001/v1/model/com ) |> #httr2::req_retry(max_tries = 3) |> httr2::req_perform() + if (httr2::resp_is_error(resp)) { + warning(sprintf("model/component-requirement failed for %s. returning empty list. %s", + source_component, httr2::resp_body_json(resp)$title)) + return(list()) + } resp |> httr2::resp_body_json() diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index ad317c57..9d52915e 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -143,7 +143,7 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 504) ) |> httr2::req_error(is_error = \(reqs) FALSE) - resp <- reqs %>% + resp <- reqs |> httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( schema_url=schema_url, @@ -157,7 +157,7 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", } else { req <- httr2::request(url) |> httr2::req_throttle(1) - resp <- req %>% + resp <- req |> httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> httr2::req_url_query( schema_url=schema_url, @@ -246,7 +246,7 @@ model_component_requirements <- function(url="http://localhost:3001/v1/model/com reqs <- httr2::request(url) |> httr2::req_retry( - max_tries = 3, + max_tries = 5, is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503) ) |> httr2::req_error(is_error = \(r) FALSE) @@ -258,6 +258,11 @@ model_component_requirements <- function(url="http://localhost:3001/v1/model/com ) |> #httr2::req_retry(max_tries = 3) |> httr2::req_perform() + if (httr2::resp_is_error(resp)) { + warning(sprintf("model/component-requirement failed for %s. returning empty list. %s", + source_component, httr2::resp_body_json(resp)$title)) + return(list()) + } resp |> httr2::resp_body_json() From 25d9056795dd8fc0527fc35e09cb59b64d519793 Mon Sep 17 00:00:00 2001 From: afwillia Date: Wed, 21 Feb 2024 09:08:57 -0800 Subject: [PATCH 45/52] Update how dashboard handles missing validation errors --- functions/dashboardFuns.R | 32 ++++++++++++++------------------ 1 file changed, 14 insertions(+), 18 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index 6880a45b..f49643ba 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -186,7 +186,6 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url access_token = access_token, file_name = manifest$Path) ) - if (!inherits(validation_res, "try-error")) { # clean validation res from schematicpy if (!length(validation_res) == 2) { validation_res <- list(list( @@ -204,21 +203,21 @@ validate_metadata <- function(metadata, project.scope, schematic_api, schema_url Result = clean_res$result, # change wrong schema to out-of-date type ErrorType = if_else(clean_res$error_type == "Wrong Schema", "Out of Date", clean_res$error_type), - errorMsg = if_else(is.null(clean_res$error_msg[1]), "Valid", paste(clean_res$error_msg[1], collapse="; ")), - WarnMsg = if_else(is.null(clean_res$warning_msg[1]), "Valid", paste(clean_res$warning_msg[1], collapse = "; ")) + errorMsg = if_else(is.na(clean_res$error_msg[1]), "Valid", paste(clean_res$error_msg[1], collapse="; ")), + WarnMsg = if_else(is.na(clean_res$warning_msg[1]), "Valid", paste(clean_res$warning_msg[1], collapse = "; ")) ) - } else { - data.frame( - Result = "Fail", - # change wrong schema to out-of-date type - ErrorType = "Unknown Error", - errorMsg = "Server Error", - WarnMsg = " " - ) - } + #} else { + # data.frame( + # Result = "Fail", + # # change wrong schema to out-of-date type + # ErrorType = "Unknown Error", + # errorMsg = "Server Error", + # WarnMsg = " " + # ) + #} } - }, mc.cores = ncores) + }, mc.cores = 1) m2 <- bind_rows(m2) cbind(metadata, m2) # expand metadata with validation results } @@ -241,7 +240,6 @@ get_schema_nodes <- function(schema, schematic_api, url, schema_url) { return(list()) } ) - if ("status" %in% names(requirement)) return(schema=as.character(schema)) if (length(requirement) == 0) { # return data type itself without name return(schema=as.character(schema)) @@ -261,8 +259,8 @@ get_metadata_nodes <- function(metadata, ncores = 1, schematic_api, if (nrow(metadata) == 0) { return(data.frame(from = NA, to = NA, folder = NA, folderSynId = NA, nMiss = NA)) } else { - mn <- parallel::mclapply(1:nrow(metadata), function(i) { - manifest <- metadata[i, ] + mn <- parallel::mclapply(1:nrow(metadata), function(n) { + manifest <- metadata[n, ] # get all required data types nodes <- tryCatch( switch(schematic_api, @@ -275,11 +273,9 @@ get_metadata_nodes <- function(metadata, ncores = 1, schematic_api, ), error = function(e) { warning("'get_metadata_nodes' failed: ", sQuote(manifest$Component), ":\n", e$message) - cat(paste0("'get_metadata_nodes' failed: ", sQuote(manifest$Component), ":\n", e$message)) return(list()) } ) - if ("status" %in% names(nodes)) nodes <- list() nodes <- list2Vector(nodes) source <- as.character(nodes) target <- names(nodes) From 20ea386cd09e0db72c9d6bf17d57d63b4e30b980 Mon Sep 17 00:00:00 2001 From: afwillia Date: Wed, 21 Feb 2024 12:12:17 -0800 Subject: [PATCH 46/52] Update synapse get api call with httr2 --- functions/synapse_rest_api.R | 204 ++++++++++++++++++++++++++++++++--- 1 file changed, 192 insertions(+), 12 deletions(-) diff --git a/functions/synapse_rest_api.R b/functions/synapse_rest_api.R index 09b6773f..e5956e62 100644 --- a/functions/synapse_rest_api.R +++ b/functions/synapse_rest_api.R @@ -54,21 +54,19 @@ synapse_is_certified <- function(url="https://repo-prod.prod.sagebase.org/repo/v #' @param auth Synapse PAT #' #' @export -synapse_get <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/entity/", +synapse_get <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/entity", id, auth) { if (is.null(id)) stop("id cannot be NULL") - req_url <- file.path(url, id) - req <- httr::GET(req_url, - httr::add_headers(Authorization=paste0("Bearer ", auth))) - - # Send error if unsuccessful query - status <- httr::http_status(req) - if (status$category != "Success") stop(status$message) - - cont <- httr::content(req) - dplyr::bind_rows(cont) - + req <- httr2::request(file.path(url, id)) + resp <- req |> + httr2::req_retry( + max_tries = 5, + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + ) |> + httr2::req_headers(Authorization = sprintf("Bearer %s", auth)) |> + httr2::req_perform() + resp |> httr2::resp_body_json() } @@ -99,3 +97,185 @@ synapse_access <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/en } +#' @title Get children of a synapse entity +#' https://rest-docs.synapse.org/rest/POST/entity/children.html +#' @param url Synapse api endpoint +#' @param auth Synapse token +#' @param parentId Synapse ID of parent folder +#' @param nextPageToken Synapse next page token +#' @param includeTypes Types to return +#' @param sortBy Variable to sort by +#' @param sortDirection sort direction +#' @param includeTotalChildCount boolean include count of children +#' @param includeSumFileSizes boolean include sum of file sizes +synapse_entity_children <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/entity/children", + auth, parentId=NULL, nextPageToken=NULL, includeTypes="project", sortBy="NAME", + sortDirection="ASC", includeTotalChildCount=FALSE, includeSumFileSizes=FALSE) { + + output <- list() + req <- httr::POST(url, + httr::add_headers(Authorization=paste0("Bearer ", auth)), + body = + list(parentId=parentId, + nextPageToken=nextPageToken, + includeTypes=includeTypes, + sortBy=sortBy, + sortDirection=sortDirection, + includeTotalChildCount=includeTotalChildCount, + includeSumFileSizes=includeSumFileSizes), + encode="json") + + resp <- httr::content(req) + output <- resp$page + + while (!is.null(resp$nextPageToken)) { + req <- httr::POST(url, + httr::add_headers(Authorization=paste0("Bearer ", auth)), + body = + list(parentId=parentId, + nextPageToken=resp$nextPageToken, + includeTypes=includeTypes, + sortBy=sortBy, + sortDirection=sortDirection, + includeTotalChildCount=includeTotalChildCount, + includeSumFileSizes=includeSumFileSizes), + encode="json") + resp <- httr::content(req) + output <- c(output, resp$page) + } + bind_rows(output) + +} + +#' @title Get projects a user has access to +#' +#' @param url Synapse api endpoint +#' @param auth Synapse token +#' @param nextPageToken Synapse next page token +synapse_projects_user <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/projects/user", auth, nextPageToken=NULL) { + principalId <- synapse_user_profile(auth = auth)[["ownerId"]] + hreq <- httr::GET(url = file.path(url, principalId), + query = list(nextPageToken=nextPageToken)) + output <- list() + resp <- httr::content(hreq) + output <- resp$results + while (!is.null(resp$nextPageToken)) { + hreq <- httr::GET(url = file.path(url, principalId), + query = list(nextPageToken=resp$nextPageToken)) + resp <- httr::content(hreq) + output <- c(output, resp$results) + } + dplyr::bind_rows(output) +} + +#' @title Get projects within scope of Synapse project +#' +#' @param url Synapse api endpoint +#' @param id Synapse ID +#' @param auth Synapse token +synapse_get_project_scope <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/entity/", + id, auth) { + if (is.null(id)) stop("id cannot be NULL") + req_url <- file.path(url, id) + req <- httr::GET(req_url, + httr::add_headers(Authorization=paste0("Bearer ", auth))) + + # Send error if unsuccessful query + status <- httr::http_status(req) + if (status$category != "Success") stop(status$message) + + cont <- httr::content(req) + unlist(cont$scopeIds) +} + +#' @param title Query a Synapse Table +#' https://rest-docs.synapse.org/rest/GET/entity/id/table/query/async/get/asyncToken.html +#' @param id Synapse table ID +#' @param auth Synapse token +#' @param query An sql query +#' @param partMask The part of the Synapse response to get. Defaults to everything. +synapse_table_query <- function(id, auth, query, partMask=0x7F) { + url <- file.path("https://repo-prod.prod.sagebase.org/repo/v1/entity",id, "table/query/async/start") + req <- httr::POST(url = url, + httr::add_headers(Authorization=paste0("Bearer ", auth)), + body = list( + query = list(sql=query), + partMask = partMask + ), + encode = "json" + ) + httr::content(req) +} + +#' @param title Get results of synapse_table_query +#' https://rest-docs.synapse.org/rest/GET/entity/id/table/query/async/get/asyncToken.html +#' @param id Synapse table ID +#' @param async_token Token from synapse_table_query +#' @param auth Synapse token +synapse_table_get <- function(id, async_token, auth) { + url <- file.path("https://repo-prod.prod.sagebase.org/repo/v1/entity", id,"table/query/async/get", async_token) + req <- httr::GET(url = url, + httr::add_headers(Authorization=paste0("Bearer ", auth))) + httr::content(req) +} + +#' @title Get column names from a Synapse table +#' https://rest-docs.synapse.org/rest/GET/entity/id/table/query/async/get/asyncToken.html +#' Uses a table query to get the column names from a Synapse table +#' @param id Synapse ID of table +#' @param auth Synapse token +get_synapse_table_names <- function(id, auth) { + query <- sprintf("select id from %s limit 1", id) + request <- synapse_table_query(id, auth, query, partMask = 0x10) + Sys.sleep(1) + response <- synapse_table_get(id, request$token, auth) + vapply(response$columnModels, function(x) x$name, character(1L)) +} + +#' @title Get storage projects within a Synapse table +#' https://rest-docs.synapse.org/rest/GET/entity/id/table/query/async/get/asyncToken.html +#' @param id Synapse ID of table +#' @param auth Synapse token +#' @param select_cols Columns to get from table +synapse_storage_projects <- function(id, auth, select_cols = c("id", "name", "parentId", "projectId", "type", "columnType")) { + table_cols <- get_synapse_table_names(id, auth) + select_cols <- intersect(select_cols, table_cols) + select_cols_format <- paste(select_cols, collapse = ", ") + query <- sprintf("select distinct %s from %s", select_cols_format, id) + request <- synapse_table_query(id, auth, query, partMask = 0x1) + Sys.sleep(1) + response <- synapse_table_get(id, request$token, auth) + + setNames( + tibble::as_tibble( + t( + vapply( + response$queryResult$queryResults$rows, function(x) { + unlist(x$values) + }, + character(length(select_cols))))), + select_cols) +} + +#' @title Download a synapse file from its URL +#' https://rest-docs.synapse.org/rest/GET/file/id.html +#' @param dataFileHandleId The dataFileHandleId from an entity +#' @param id The synapse ID of the file to download +#' @param auth Synapse token +#' @param filepath Optional path to download data. If NULL, return a data frame. +synapse_download_file_handle <- function(dataFileHandleId, id, auth, filepath=NULL) { + url <- sprintf("https://repo-prod.prod.sagebase.org/file/v1/file/%s", dataFileHandleId) + request <- httr::GET(url = url, + httr::add_headers( Authorization=paste0("Bearer ", auth)), + query = list( + redirect = FALSE, + fileAssociateId = id, + fileAssociateType = "FileEntity" + ) + ) + download_url <- httr::content(request) + destfile <- ifelse(is.null(filepath), tempfile(), filepath) + download.file(download_url, destfile) + if (is.null(filepath)) readr::read_csv(destfile, show_col_types = FALSE) + +} From f4a2ad02b9e41c09737bdb6aa84ad5c09ab408a5 Mon Sep 17 00:00:00 2001 From: afwillia Date: Thu, 22 Feb 2024 08:39:17 -0800 Subject: [PATCH 47/52] Loop through unique parentIDs in manifest fileview, in case of duplicate entries. --- functions/dashboardFuns.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index f49643ba..7384c26f 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -16,7 +16,8 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= asset_view=fileview) ) file_view <- filter(file_view, grepl("synapse_storage_manifest_", name) & parentId %in% datasets) - + file_view$contentType <- NA + file_view <- as_tibble(lapply(file_view, unlist)) # datasets don't have a manifest ds_no_manifest <- datasets[which(!datasets %in% file_view$parentId)] @@ -39,7 +40,7 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= ) cols <- setNames(rep("", length(cols)), cols) metadata <- bind_rows(cols)[0, ] - metadata_list <- parallel::mclapply(file_view$parentId, function(dataset) { + metadata_list <- parallel::mclapply(unique(file_view$parentId), function(dataset) { # get manifest's synapse id(s) in each dataset folder manifest_ids <- file_view$id[file_view$parentId == dataset] # in case, multiple manifests exist in the same dataset From a3d937f92d3a3dbe20f8194b08d2cee0e10a6d2e Mon Sep 17 00:00:00 2001 From: afwillia Date: Mon, 26 Feb 2024 15:02:52 -0800 Subject: [PATCH 48/52] Add throttling to validation and manifest download --- R/schematic_rest_api.R | 5 +++-- functions/schematic_rest_api.R | 5 +++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/R/schematic_rest_api.R b/R/schematic_rest_api.R index 9d52915e..8244c0b1 100644 --- a/R/schematic_rest_api.R +++ b/R/schematic_rest_api.R @@ -23,7 +23,7 @@ manifest_download <- function(url = "http://localhost:3001/v1/manifest/download" req <- httr2::request(url) |> httr2::req_retry( max_tries = 3, - is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503) + is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 403) ) |> httr2::req_error(is_error = \(r) FALSE) resp <- req |> @@ -140,8 +140,9 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", reqs <- httr2::request(url) |> httr2::req_retry( max_tries = 3, - is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 504) + is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 504, 403) ) |> + httr2::req_throttle(1/2) |> httr2::req_error(is_error = \(reqs) FALSE) resp <- reqs |> httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> diff --git a/functions/schematic_rest_api.R b/functions/schematic_rest_api.R index 9d52915e..8244c0b1 100644 --- a/functions/schematic_rest_api.R +++ b/functions/schematic_rest_api.R @@ -23,7 +23,7 @@ manifest_download <- function(url = "http://localhost:3001/v1/manifest/download" req <- httr2::request(url) |> httr2::req_retry( max_tries = 3, - is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503) + is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 403) ) |> httr2::req_error(is_error = \(r) FALSE) resp <- req |> @@ -140,8 +140,9 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate", reqs <- httr2::request(url) |> httr2::req_retry( max_tries = 3, - is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 504) + is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 504, 403) ) |> + httr2::req_throttle(1/2) |> httr2::req_error(is_error = \(reqs) FALSE) resp <- reqs |> httr2::req_headers(Authorization = sprintf("Bearer %s", access_token)) |> From bfbabec6502888baa7d112a85a7f7e96a5328946 Mon Sep 17 00:00:00 2001 From: afwillia Date: Mon, 26 Feb 2024 15:04:00 -0800 Subject: [PATCH 49/52] add endpoint for downloading an asset view --- R/synapse_rest_api.R | 46 ++++++++++++++++++++++++++++++++---- functions/synapse_rest_api.R | 46 ++++++++++++++++++++++++++++++++---- 2 files changed, 82 insertions(+), 10 deletions(-) diff --git a/R/synapse_rest_api.R b/R/synapse_rest_api.R index e5956e62..21435858 100644 --- a/R/synapse_rest_api.R +++ b/R/synapse_rest_api.R @@ -62,8 +62,9 @@ synapse_get <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/entit resp <- req |> httr2::req_retry( max_tries = 5, - is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 403) ) |> + httr2::req_throttle(1/2) |> httr2::req_headers(Authorization = sprintf("Bearer %s", auth)) |> httr2::req_perform() resp |> httr2::resp_body_json() @@ -214,9 +215,17 @@ synapse_table_query <- function(id, auth, query, partMask=0x7F) { #' @param auth Synapse token synapse_table_get <- function(id, async_token, auth) { url <- file.path("https://repo-prod.prod.sagebase.org/repo/v1/entity", id,"table/query/async/get", async_token) - req <- httr::GET(url = url, - httr::add_headers(Authorization=paste0("Bearer ", auth))) - httr::content(req) + request <- httr2::request(url) + response <- request |> + httr2::req_retry( + max_tries = 5, + is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 202, 403) + ) |> + httr2::req_throttle(1/2) |> + httr2::req_headers(Authorization = sprintf("Bearer %s", auth)) |> + httr2::req_perform() + httr2::resp_body_json(response) + } #' @title Get column names from a Synapse table @@ -243,7 +252,6 @@ synapse_storage_projects <- function(id, auth, select_cols = c("id", "name", "pa select_cols_format <- paste(select_cols, collapse = ", ") query <- sprintf("select distinct %s from %s", select_cols_format, id) request <- synapse_table_query(id, auth, query, partMask = 0x1) - Sys.sleep(1) response <- synapse_table_get(id, request$token, auth) setNames( @@ -279,3 +287,31 @@ synapse_download_file_handle <- function(dataFileHandleId, id, auth, filepath=NU if (is.null(filepath)) readr::read_csv(destfile, show_col_types = FALSE) } + +#' @title Download the storage manifest records from an asset view table +synapse_get_manifests_in_asset_view <- function(id, auth) { + request <- synapse_table_query( + id = id, + auth = auth, + query = paste("select * from", + id, + "where name like 'synapse|_storage|_manifest|_%' escape '|'"), + partMask = 0x11) + response <- synapse_table_get( + id = id, + async_token = request$token, + auth = auth) + # Format the query results by reshaping the results list and getting column + # names. partMask 0x11 gets queryResults and column names + setNames( + tibble::as_tibble( + t( + vapply( + response$queryResult$queryResults$rows, function(x) { + null_ind <- which(sapply(x$values, is.null)) + x$values[null_ind] <- NA + unlist(x$values) + }, + character(length(response$columnModels))))), + vapply(response$columnModels, function(x) x$name,character(1L))) +} diff --git a/functions/synapse_rest_api.R b/functions/synapse_rest_api.R index e5956e62..21435858 100644 --- a/functions/synapse_rest_api.R +++ b/functions/synapse_rest_api.R @@ -62,8 +62,9 @@ synapse_get <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/entit resp <- req |> httr2::req_retry( max_tries = 5, - is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503) + is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 403) ) |> + httr2::req_throttle(1/2) |> httr2::req_headers(Authorization = sprintf("Bearer %s", auth)) |> httr2::req_perform() resp |> httr2::resp_body_json() @@ -214,9 +215,17 @@ synapse_table_query <- function(id, auth, query, partMask=0x7F) { #' @param auth Synapse token synapse_table_get <- function(id, async_token, auth) { url <- file.path("https://repo-prod.prod.sagebase.org/repo/v1/entity", id,"table/query/async/get", async_token) - req <- httr::GET(url = url, - httr::add_headers(Authorization=paste0("Bearer ", auth))) - httr::content(req) + request <- httr2::request(url) + response <- request |> + httr2::req_retry( + max_tries = 5, + is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 202, 403) + ) |> + httr2::req_throttle(1/2) |> + httr2::req_headers(Authorization = sprintf("Bearer %s", auth)) |> + httr2::req_perform() + httr2::resp_body_json(response) + } #' @title Get column names from a Synapse table @@ -243,7 +252,6 @@ synapse_storage_projects <- function(id, auth, select_cols = c("id", "name", "pa select_cols_format <- paste(select_cols, collapse = ", ") query <- sprintf("select distinct %s from %s", select_cols_format, id) request <- synapse_table_query(id, auth, query, partMask = 0x1) - Sys.sleep(1) response <- synapse_table_get(id, request$token, auth) setNames( @@ -279,3 +287,31 @@ synapse_download_file_handle <- function(dataFileHandleId, id, auth, filepath=NU if (is.null(filepath)) readr::read_csv(destfile, show_col_types = FALSE) } + +#' @title Download the storage manifest records from an asset view table +synapse_get_manifests_in_asset_view <- function(id, auth) { + request <- synapse_table_query( + id = id, + auth = auth, + query = paste("select * from", + id, + "where name like 'synapse|_storage|_manifest|_%' escape '|'"), + partMask = 0x11) + response <- synapse_table_get( + id = id, + async_token = request$token, + auth = auth) + # Format the query results by reshaping the results list and getting column + # names. partMask 0x11 gets queryResults and column names + setNames( + tibble::as_tibble( + t( + vapply( + response$queryResult$queryResults$rows, function(x) { + null_ind <- which(sapply(x$values, is.null)) + x$values[null_ind] <- NA + unlist(x$values) + }, + character(length(response$columnModels))))), + vapply(response$columnModels, function(x) x$name,character(1L))) +} From fcfd7a7c943896424eeccf735ed790b68f220c24 Mon Sep 17 00:00:00 2001 From: afwillia Date: Mon, 26 Feb 2024 15:04:43 -0800 Subject: [PATCH 50/52] limit the file view query in dashboard --- functions/dashboardFuns.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/functions/dashboardFuns.R b/functions/dashboardFuns.R index 7384c26f..bc168cd2 100644 --- a/functions/dashboardFuns.R +++ b/functions/dashboardFuns.R @@ -11,13 +11,12 @@ get_dataset_metadata <- function(syn.store, datasets, ncores = 1, schematic_api= # get data for all manifests within the specified datasets file_view <- switch(schematic_api, reticulate = syn.store$storageFileviewTable, - rest = get_asset_view_table(url = file.path("https://schematic-dev.api.sagebionetworks.org/v1/storage/assets/tables"), - access_token = access_token, - asset_view=fileview) + rest = synapse_get_manifests_in_asset_view( + id = fileview, + auth = access_token + ) ) file_view <- filter(file_view, grepl("synapse_storage_manifest_", name) & parentId %in% datasets) - file_view$contentType <- NA - file_view <- as_tibble(lapply(file_view, unlist)) # datasets don't have a manifest ds_no_manifest <- datasets[which(!datasets %in% file_view$parentId)] From 4bcfca921dd762ac9bae24507d38e9dbb3e29dfb Mon Sep 17 00:00:00 2001 From: afwillia Date: Tue, 27 Feb 2024 09:32:11 -0800 Subject: [PATCH 51/52] remove throttling from table get --- R/synapse_rest_api.R | 2 -- functions/synapse_rest_api.R | 2 -- 2 files changed, 4 deletions(-) diff --git a/R/synapse_rest_api.R b/R/synapse_rest_api.R index 21435858..ea390b94 100644 --- a/R/synapse_rest_api.R +++ b/R/synapse_rest_api.R @@ -64,7 +64,6 @@ synapse_get <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/entit max_tries = 5, is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 403) ) |> - httr2::req_throttle(1/2) |> httr2::req_headers(Authorization = sprintf("Bearer %s", auth)) |> httr2::req_perform() resp |> httr2::resp_body_json() @@ -221,7 +220,6 @@ synapse_table_get <- function(id, async_token, auth) { max_tries = 5, is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 202, 403) ) |> - httr2::req_throttle(1/2) |> httr2::req_headers(Authorization = sprintf("Bearer %s", auth)) |> httr2::req_perform() httr2::resp_body_json(response) diff --git a/functions/synapse_rest_api.R b/functions/synapse_rest_api.R index 21435858..ea390b94 100644 --- a/functions/synapse_rest_api.R +++ b/functions/synapse_rest_api.R @@ -64,7 +64,6 @@ synapse_get <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/entit max_tries = 5, is_transient = \(resp) httr2::resp_status(resp) %in% c(429, 500, 503, 403) ) |> - httr2::req_throttle(1/2) |> httr2::req_headers(Authorization = sprintf("Bearer %s", auth)) |> httr2::req_perform() resp |> httr2::resp_body_json() @@ -221,7 +220,6 @@ synapse_table_get <- function(id, async_token, auth) { max_tries = 5, is_transient = \(r) httr2::resp_status(r) %in% c(429, 500, 503, 202, 403) ) |> - httr2::req_throttle(1/2) |> httr2::req_headers(Authorization = sprintf("Bearer %s", auth)) |> httr2::req_perform() httr2::resp_body_json(response) From 0e87fd7bfa33efc4965cdb017c0f46a473f6503e Mon Sep 17 00:00:00 2001 From: afwillia Date: Mon, 4 Mar 2024 10:24:23 -0800 Subject: [PATCH 52/52] Remove extra closing brackets from the last merge. --- server.R | 1 - 1 file changed, 1 deletion(-) diff --git a/server.R b/server.R index e5b168ea..6120cfc6 100644 --- a/server.R +++ b/server.R @@ -313,7 +313,6 @@ shinyServer(function(input, output, session) { ) }) }) - }) updateTabsetPanel(session, "tabs", selected = "tab_project")