Merge pull request #623 from Sage-Bionetworks/develop

Release 24.10.1

Dockerfile

@@ -1,4 +1,4 @@
-FROM ghcr.io/afwillia/shiny-base:release-1.9
+FROM ghcr.io/afwillia/shiny-base:release-1.12
 
 # add version tag as a build argument
 ARG DCA_VERSION

R/schematic_rest_api.R

@@ -134,7 +134,8 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate",
                               access_token,
                               asset_view = NULL,
                               json_str = NULL,
-                              data_model_labels = "class_label") {
+                              data_model_labels = "class_label",
+                              dataset_scope = NULL) {
 
   flattenbody <- function(x) {
     # A form/query can only have one value per name, so take
@@ -175,7 +176,8 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate",
         restrict_rules=restrict_rules,
         project_scope = project_scope,
         data_model_labels = data_model_labels,
-        asset_view = asset_view
+        asset_view = asset_view,
+        dataset_scope = dataset_scope
       ) |>
       httr2::req_body_multipart(file_name=curl::form_file(file_name)) |>
       httr2::req_perform()
@@ -191,7 +193,8 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate",
         project_scope = project_scope,
         asset_view = asset_view,
         data_model_labels = data_model_labels,
-        json_str = json_str
+        json_str = json_str,
+        dataset_scope = dataset_scope
       ) |>
       #httr2::req_retry(
       #  max_tries = 3,
@@ -216,7 +219,14 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate",
   #     )
   #   )
   # }
-  httr2::resp_body_json(resp)
+  if (httr2::resp_is_error(resp)) {
+    list(list(
+      "errors" = list(
+        Row = NA, Column = NA, Value = NA,
+        Error = httr2::resp_body_string(resp)
+      )
+    ))
+  } else httr2::resp_body_json(resp)
 }
 
 

R/synapse_rest_api.R

@@ -146,7 +146,7 @@ synapse_entity_children <- function(url = "https://repo-prod.prod.sagebase.org/r
     resp <- httr::content(req)
     output <- c(output, resp$page)
   }
-  bind_rows(output)
+  dplyr::bind_rows(output)
 
 }
 
@@ -157,6 +157,9 @@ synapse_entity_children <- function(url = "https://repo-prod.prod.sagebase.org/r
 #' @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"]]
+
+  if (is.null(principalId)) stop("Synapse token not valid")
+
   hreq <- httr::GET(url = file.path(url, principalId),
                     query = list(nextPageToken=nextPageToken))
   output <- list()
@@ -174,7 +177,7 @@ synapse_projects_user <- function(url = "https://repo-prod.prod.sagebase.org/rep
 #' @title Get projects within scope of Synapse project
 #' 
 #' @param url Synapse api endpoint
-#' @param id Synapse ID
+#' @param id Synapse project ID
 #' @param auth Synapse token
 synapse_get_project_scope <- function(url = "https://repo-prod.prod.sagebase.org/repo/v1/entity/",
                                       id, auth) {

R/utils.R

@@ -11,4 +11,18 @@ parse_env_var <- function(x, el_delim=",", kv_delim=":"){
     kv <- stringr::str_split(y, kv_delim, n=2)
     setNames(kv[[1]][[2]], kv[[1]][[1]])
   }))
+}
+
+#' @title Truncate the results of schematic validation
+#' @param x Schematic validation result
+#' @param n Number of records to keep
+#' @export
+format_validation_response <- function(x, n = 50) {
+  if ("errors" %in% names(x) && length(x$errors) > n) {
+    x$errors <- x$errors[1:n]
+  }
+  if ("warnings" %in% names(x) && length(x$warnings) > n) {
+    x$warnings <- x$warnings[1:n]
+  }
+  x
 }

functions/schematic_rest_api.R

@@ -6,6 +6,11 @@ check_success <- function(x){
   if (tolower(status$category) == "success") {
     return()
   } else {
+    # Return content text for Data Type errors
+    if (grepl("LookupError: The DataType", httr::content(x, "text"))) {
+      stop(httr::content(x, "text"))
+    }
+
     stop(sprintf("Response from server: %s", status$reason))
   }
 }
@@ -129,7 +134,8 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate",
                               access_token,
                               asset_view = NULL,
                               json_str = NULL,
-                              data_model_labels = "class_label") {
+                              data_model_labels = "class_label",
+                              dataset_scope = NULL) {
 
   flattenbody <- function(x) {
     # A form/query can only have one value per name, so take
@@ -170,7 +176,8 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate",
         restrict_rules=restrict_rules,
         project_scope = project_scope,
         data_model_labels = data_model_labels,
-        asset_view = asset_view
+        asset_view = asset_view,
+        dataset_scope = dataset_scope
       ) |>
       httr2::req_body_multipart(file_name=curl::form_file(file_name)) |>
       httr2::req_perform()
@@ -186,7 +193,8 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate",
         project_scope = project_scope,
         asset_view = asset_view,
         data_model_labels = data_model_labels,
-        json_str = json_str
+        json_str = json_str,
+        dataset_scope = dataset_scope
       ) |>
       #httr2::req_retry(
       #  max_tries = 3,
@@ -211,7 +219,14 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate",
   #     )
   #   )
   # }
-  httr2::resp_body_json(resp)
+  if (httr2::resp_is_error(resp)) {
+    list(list(
+      "errors" = list(
+        Row = NA, Column = NA, Value = NA,
+        Error = httr2::resp_body_string(resp)
+      )
+    ))
+  } else httr2::resp_body_json(resp)
 }
 
 
@@ -221,8 +236,18 @@ manifest_validate <- function(url="http://localhost:3001/v1/model/validate",
 #' @param schema_url URL to a schema jsonld 
 #' @param data_type Type of dataset
 #' @param dataset_id Synapse ID of existing manifest
-#' @param access_token Synapse login cookie, PAT, or API key.
-#' @param csv_file Filepath of csv to validate
+#' @param restrict_rules Default = FALSE
+#' @param access_token Synapse login cookie, PAT, or API key
+#' @param json_str Json string to submit
+#' @param asset_view Synapse fileview
+#' @param manifest_record_type Default = "table_and_file"
+#' @param file_name Name of file
+#' @param table_manipulation Default = "replace"
+#' @param hide_blanks Default = FALSE
+#' @param table_column_names Default = "class_and_label"
+#' @param annotation_keys Default = "class_and_label"
+#' @param data_model_labels Default = "class_and_label"
+#' @param upload_file_annotations Default = TRUE
 #' 
 #' @returns TRUE if successful upload or validate errors if not.
 #' @export
@@ -240,7 +265,8 @@ model_submit <- function(url="http://localhost:3001/v1/model/submit",
                          hide_blanks=FALSE,
                          table_column_names="class_label",
                          annotation_keys="class_label",
-                         data_model_labels="class_label") {
+                         data_model_labels="class_label",
+                         file_annotations_upload=TRUE) {
   req <- httr::POST(url,
                     httr::add_headers(Authorization = sprintf("Bearer %s", access_token)),
                     query=list(
@@ -255,7 +281,8 @@ model_submit <- function(url="http://localhost:3001/v1/model/submit",
                       table_column_names=table_column_names,
                       annotation_keys=annotation_keys,
                       data_model_labels=data_model_labels,
-                      hide_blanks=hide_blanks),
+                      hide_blanks=hide_blanks,
+                      file_annotations_upload=file_annotations_upload),
                     body=list(file_name=httr::upload_file(file_name))
                     #body=list(file_name=file_name)
   )
@@ -397,7 +424,7 @@ get_asset_view_table <- function(url="http://localhost:3001/v1/storage/assets/ta
 
   check_success(req)
   if (return_type=="json") {
-    return(list2DF(fromJSON(httr::content(req))))
+    return(list2DF(jsonlite::fromJSON(httr::content(req))))
   } else {
   csv <- readr::read_csv(httr::content(req), show_col_types = FALSE)
   return(csv)

global.R

@@ -106,22 +106,7 @@ app <- oauth_app("shinysynapse",
 
 # These are the user info details ('claims') requested from Synapse:
 claims <- list(
-  family_name = NULL,
-  given_name = NULL,
-  email = NULL,
-  email_verified = NULL,
-  userid = NULL,
-  orcid = NULL,
-  is_certified = NULL,
-  is_validated = NULL,
-  validated_given_name = NULL,
-  validated_family_name = NULL,
-  validated_location = NULL,
-  validated_email = NULL,
-  validated_company = NULL,
-  validated_at = NULL,
-  validated_orcid = NULL,
-  company = NULL
+  userid = NULL
 )
 
 claimsParam <- toJSON(list(id_token = claims, userinfo = claims))

modules/DTable.R

@@ -57,7 +57,7 @@ DTableServer <- function(id, data, escape = TRUE,
         df <- df %>% formatStyle(1:ncol(data), border = "1px solid #ddd")
       }
 
-      output$table <- renderDT(df, future = TRUE)
+      output$table <- renderDT(df, future = TRUE, server = TRUE)
     }
   )
 }

server.R

@@ -279,6 +279,7 @@ shinyServer(function(input, output, session) {
         try(
           {
             scopes <- synapse_get_project_scope(id = .asset_view, auth = access_token)
+            scopes <- unique(scopes)
             scope_access <- vapply(scopes, function(x) {
               synapse_access(id = x, access = "DOWNLOAD", auth = access_token)
             }, 1L)
@@ -805,14 +806,16 @@ shinyServer(function(input, output, session) {
     .dd_template <- input$dropdown_template
     .restrict_rules <- dcc_config_react()$schematic$model_validate$restrict_rules
     .project_scope <- NULL
+    .dataset_scope <- selected$folder()
     .access_token <- access_token
     .data_model_labels <- dcc_config_react()$schematic$global$data_model_labels
     # asset view must be NULL to avoid cross-manifest validation.
+    # however, it is necessary for filename validation
+    # always pass asset view, let the data model decide which validations are run
     # doing this in a verbose way to avoid warning with ifelse
-    .asset_view <- NULL
+    .asset_view <- selected$master_asset_view()
     if (!is.null(dcc_config_react()$schematic$model_validate$enable_cross_manifest_validation) &
         isTRUE(dcc_config_react()$schematic$model_validate$enable_cross_manifest_validation)) {
-      .asset_view <- selected$master_asset_view()
       .project_scope <- selected$project()
     }
 
@@ -833,7 +836,8 @@ shinyServer(function(input, output, session) {
           project_scope = .project_scope,
           access_token = .access_token,
           data_model_labels = .data_model_labels,
-          asset_view = .asset_view
+          asset_view = .asset_view,
+          dataset_scope = .dataset_scope
         ),
         {
           list(list(
@@ -846,6 +850,7 @@ shinyServer(function(input, output, session) {
       )
 
       # validation messages
+      annotation_status <- format_validation_response(annotation_status, 50)
       validationResult(annotation_status, .dd_template, .infile_data)
     }) %...>% validation_res()
   })
@@ -1067,7 +1072,7 @@ shinyServer(function(input, output, session) {
       .restrict_rules <- dcc_config_react()$schematic$model_validate$restrict_rules
       .hide_blanks <- dcc_config_react()$schematic$model_submit$hide_blanks
       .file_annotations_upload <- dcc_config_react()$schematic$model_submit$file_annotations_upload
-      
+
       # associates metadata with data and returns manifest id
       promises::future_promise({
         try(

shiny-server.conf

@@ -25,6 +25,9 @@ server {
     # When a user visits the base URL rather than a particular application,
     # an index of the applications available in this directory will NOT be shown.
     directory_index off;
+
+    # Don't automatically reap user's session upon disconnect
+    reconnect false;
 
   }
 }