diff --git a/DESCRIPTION b/DESCRIPTION index 0d4d771..257c765 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: susoapi Title: Interface for Survey Solutions' APIs -Version: 0.2.0 +Version: 0.2.1 Authors@R: person(given = "Arthur", family = "Shaw", @@ -13,7 +13,7 @@ BugReports: https://github.com/arthur-shaw/susoapi/issues Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.0 +RoxygenNote: 7.2.1 Imports: httr, purrr, diff --git a/NAMESPACE b/NAMESPACE index 98b5d76..4c1d217 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(add_user_to_map) export(approve_interview_as_hq) export(approve_interview_as_sup) export(archive_assignment) @@ -17,6 +18,7 @@ export(create_user) export(create_workspace) export(delete_global_notice) export(delete_interview) +export(delete_user_from_map) export(delete_workspace) export(disable_workspace) export(enable_workspace) @@ -24,6 +26,7 @@ export(get_assignment_details) export(get_assignment_history) export(get_assignment_quantity_setting) export(get_assignments) +export(get_assignments_gql) export(get_export_file) export(get_export_job_details) export(get_export_jobs) @@ -34,6 +37,7 @@ export(get_interview_transcript) export(get_interviewers) export(get_interviews) export(get_interviews_for_questionnaire) +export(get_maps) export(get_questionnaire_document) export(get_questionnaires) export(get_supervisors) @@ -65,12 +69,14 @@ importFrom(assertthat,is.number) importFrom(assertthat,is.string) importFrom(curl,has_internet) importFrom(dplyr,`%>%`) +importFrom(dplyr,group_by) importFrom(dplyr,if_else) importFrom(dplyr,left_join) importFrom(dplyr,pull) importFrom(dplyr,rename_with) importFrom(dplyr,select) importFrom(dplyr,starts_with) +importFrom(dplyr,summarize) importFrom(fs,path) importFrom(glue,backtick) importFrom(glue,double_quote) diff --git a/R/assignments_gql.R b/R/assignments_gql.R new file mode 100644 index 0000000..6d35c21 --- /dev/null +++ b/R/assignments_gql.R @@ -0,0 +1,405 @@ +#TODO: Fetch calendarevent details + +#' Get the total count of assignments +#' +#' (Preliminary) GraphQL implementation of `assignments(...)` endpoint. +#' +#' @param supervisor_id Character. User ID (GUID) of supervisor. +#' @param archived Query archived or non-archived assignments +#' @param where 'where' filter condition for query +#' @param server Full server web address (e.g., \code{https://demo.mysurvey.solutions}, \code{https://my.domain}) +#' @param workspace Character. Name of the workspace whose assignments to get. In workspace list, value of `NAME`, not `DISPLAY NAME`, for the target workspace. +#' @param user API user name +#' @param password API password +#' +#' @return Total count of assignments on the server that meet the user-specified search criteria. +#' +#' @import ghql +#' @importFrom jsonlite base64_enc fromJSON +#' @importFrom glue glue double_quote backtick + +#' @noRd +get_assignments_count_gql <- function( + server = Sys.getenv("SUSO_SERVER"), # full server address + workspace = Sys.getenv("SUSO_WORKSPACE"), + user = Sys.getenv("SUSO_USER"), # API user name + password = Sys.getenv("SUSO_PASSWORD"), # API password + archived=FALSE, + where="" +) { + + # compose the GraphQL request client + assignments_request <- ghql::GraphqlClient$new( + url = paste0(server, "/graphql"), + headers = list(authorization = paste0( + "Basic ", jsonlite::base64_enc(input = paste0(user, ":", password))) + ) + ) + + #Update archived + archivedql <- ifelse(archived,"true","false") + + # compose the query for all assignments + + # use string interpolation to pipe double-quoted workspace name into query + qry <- ghql::Query$new() + qry$query("assignments", + glue::glue("{ + assignments ( + workspace: + take: 1 + skip: 0 + where: { + + } + ) { + filteredCount + } + }", .open = "<", .close = ">") + ) + + + # send request + assignments_result <- assignments_request$exec(qry$queries$assignments) + + # convert JSON payload to data frame + assignments <- jsonlite::fromJSON(assignments_result, flatten = TRUE) + + # extract total number of assignments + assignments_count <- assignments$data$assignments$filteredCount + + assignments_info <- list(assignments = assignments, assignments_count = assignments_count) + + return(assignments_info) + +} + + +#' Get one chunk of assignments +#' +#' @param take_n Numeric. Number of maps to take in one request. +#' @param skip_n Numeric. Number of maps to skip when paging through results. +#' @param where 'where' filter condition for query +#' @param nodes Character vector. Names of attributes to fetch for each map +#' @param archived Query archived or non-archived assignments +#' @param server Character. Full server web address (e.g., \code{https://demo.mysurvey.solutions}, \code{https://my.domain}) +#' @param workspace Character. Name of the workspace whose maps to get. In workspace list, value of `NAME`, not `DISPLAY NAME`, for the target workspace. +#' @param user Character. API or admin user name for user that access to the workspace. +#' @param password Character. API or admin password +#' +#' @return Data frame. Maps +#' +#' @import ghql +#' @importFrom jsonlite base64_enc fromJSON +#' @importFrom glue glue double_quote backtick +#' @importFrom dplyr `%>%` pull select rename_with starts_with left_join group_by summarize +#' @importFrom purrr map_if discard map_int +#' @importFrom rlang .data is_empty +#' @importFrom tibble as_tibble +#' @importFrom tidyr unnest pivot_wider +#' +#' @noRd +get_assignments_by_chunk_gql <- function( + take_n = 100, + skip_n = 0, + where="", + nodes = c( + "archived", + "createdAtUtc", + "email", + "id", + "interviewsNeeded", + "receivedByTabletAtUtc", + "responsibleId", + "webMode", + "calendarEvent" + ), + archived=FALSE, # If archived should be captured as well + server = Sys.getenv("SUSO_SERVER"), # full server address + workspace = Sys.getenv("SUSO_WORKSPACE"), + user = Sys.getenv("SUSO_USER"), # API user name + password = Sys.getenv("SUSO_PASSWORD") # API password +) { + + + # compose the GraphQL request client + assignments_request<- ghql::GraphqlClient$new( + url = paste0(server, "/graphql"), + headers = list(authorization = paste0( + "Basic ", jsonlite::base64_enc(input = paste0(user, ":", password))) + ) + ) + + # determine whether requested calendarevent + has_ce <- "calendarEvent" %in% nodes + # expand users node if relevant + if (has_ce) { + nodes[which(nodes == "calendarEvent")] <- + "calendarEvent { + assignmentId + comment + creatorUserId + interviewId + interviewKey + isCompleted + publicKey + startTimezone + startUtc + updateDateUtc + }" + } + + # expand users node if relevant + # compose the query for all maps + # use string interpolation to pipe double-quoted workspace name into query + #Determine if archived or not and translate to graphql + archivedql <- ifelse(archived,"true","false") + + qry <- ghql::Query$new() + + qry$query("assignments", + stringr::str_squish((glue::glue("{ + assignments ( + workspace: + take: + skip: + where: { + + } + + ) { + nodes { + + } + filteredCount + } + }", .open = "<", .close = ">"))) + ) + + + + # send request + assignments_result <- assignments_request$exec(qry$queries$assignments) + + # convert JSON payload to data frame + assignments <- jsonlite::fromJSON(assignments_result, flatten = TRUE) + + # extract number of maps returned in request + assignment_count <- assignments$data$assignments$filteredCount + + if ("errors" %in% names(assignments)) { + + # extract and display error(s) + errors <- dplyr::pull(assignments$errors) %>% paste0(collapse = "\n") + stop(errors) + + } else if (assignment_count == 0) { + + message(glue::glue( + "No assignments found in workspace {glue::backtick(workspace)}.", + "If this result is surprising, check the input in the `workspace` parameter.", + .sep = "\n" + )) + + } else if (assignment_count > 0) { + + # extract map data payload + assignments_df <- assignments$data$assignments$nodes %>% + purrr::map_if(is.data.frame, list) %>% + tibble::as_tibble() + + # if (has_ce) { + # + # # extract assignments attributes from the payload + # id_cols <- names(assignments_df) %in% c("calendarEvent") + # assignments_attribs_df <- dplyr::select(assignments_df, -.data$calendarEvent) + # + # # extract (nested) identifying data + # users_df <- assignments_df %>% + # dplyr::select(.data$fileName, .data$calendarEvent) %>% + # purrr::discard(rlang::is_empty) %>% + # purrr::map_if(is.data.frame, list) %>% + # tibble::as_tibble() %>% + # tidyr::unnest(.data$users) %>% + # #Reshape to match SuSo format + # dplyr::group_by(fileName) %>% + # dplyr::summarize(users = paste(userName, collapse = ',')) + # + # # combine map attributes and identifying data + # map_list_df <- assignments_attribs_df %>% + # dplyr::left_join(users_df, by = "fileName") + # + # } else if (has_ce == FALSE) { + + assignments_list_df <- assignments_df + + # } + + return(assignments_list_df) + + } + +} + + +#' Get all assignments +#' +#' Get all assignments for query parameters. (Preliminary) GraphQL implementation of `assignments(...)` endpoint. +#' +#' @param qnr_id Questionnaire ID. GUID provided by the server. +#' @param qnr_version Questionnaire version. Version number provided by the server. +#' @param nodes Character vector. Names of attributes to fetch for each map +#' @param assignment.ids List with named object 'in' or 'nin' which contains assignment ids to be filtered. +#' @param archived Query archived or non-archived assignments +#' @param chunk_size Numeric. Number of records to take in one request. +#' @param server Full server web address (e.g., \code{https://demo.mysurvey.solutions}, \code{https://my.domain}) +#' @param workspace Character. Name of the workspace whose assignments to get. In workspace list, value of `NAME`, not `DISPLAY NAME`, for the target workspace. +#' @param user User name +#' @param password Password +#' +#' @return Data frame of all assignments that meet search criteria. +#' +#' @importFrom assertthat assert_that is.string is.flag +#' @importFrom purrr map_dfr map_chr +#' +#' @export +get_assignments_gql <- function( + qnr_id="", + qnr_version =NULL, + nodes = c( + "archived", + "createdAtUtc", + "email", + "id", + "interviewsNeeded", + "receivedByTabletAtUtc", + "responsibleId", + "webMode", + "calendarEvent" + ), + assignment.ids=NULL, + archived=FALSE, + chunk_size = 100, + server = Sys.getenv("SUSO_SERVER"), # full server address + workspace = Sys.getenv("SUSO_WORKSPACE"), + user = Sys.getenv("SUSO_USER"), # API user name + password = Sys.getenv("SUSO_PASSWORD") # API password +) { + + # check inputs + + # workspace: + # - invalid name + # - workspace does not exist + check_workspace_param(workspace = workspace) + + assertthat::assert_that( + is_guid(qnr_id) , + msg = "Invalid `qnr_id`. The value must be a valid GUID." + ) + + #Assignment ID Filter + if (!is.null(assignment.ids)) { + assertthat::assert_that(is.list(assignment.ids) & length(assignment.ids)==1,msg="assignment.ids must be a list of length 1") + assertthat::assert_that(names(assignment.ids) %in% c("in","nin"),msg="Only 'in' and 'nin' are currently supported to filter assignment.ids. Adjust name of list element") + assertthat::assert_that(all(assignment.ids[[1]] <=999999999 & !is.na(assignment.ids[[1]])),msg="Assignment Ids must be <=999999999 and not NA") + } + + # nodes in known list + nodes_allowed = c( + "archived", + "createdAtUtc", + "email", + "id", + "interviewsNeeded", + "receivedByTabletAtUtc", + "responsibleId", + "webMode", + "calendarEvent" + ) + + assertthat::assert_that( + all(nodes %in% nodes_allowed), + msg = "Invalid node listed in `node`. See documentation for allowed nodes." + ) + + # nodes must contain `id` + if (!"id" %in% nodes) { + stop("The requested nodes must contain `id`.") + } + + #Determine if archived or not and translate to graphql + archivedql <- ifelse(archived,"true","false") + + #Make conditional 'where' filter since AssignmentsFilter 'QuestionnaireIdentiy-version:' doesn't allow null + #So either just questionnaire identiy or also version + #TODO: Beautify, to allow multiple 'where' + where_filter <- paste0(c(glue::glue("archived: {eq: }", + " questionnaireId: { id: {eq: }", .open = "<", .close = ">"), + #ADD QNR VERSION + ifelse( + test=!is.null(qnr_version), + yes=glue::glue(" version: {eq: }}",.open = "<", .close = ">"), + no="}"), + #ADD ASSIGNMENT ID + ifelse( + test=!is.null(assignment.ids), + yes=glue::glue(" id: {: []}",.open = "<", .close = ">"), + no="") + + ) , collapse = '') + + + # get total count of assignments + assignments_info <- get_assignments_count_gql( + where=where_filter, + workspace = workspace, + server = server, + user = user, + password = password, + archived = archived + ) + + # case 1: handle "errors" + # if request returns errors + if ("errors" %in% names(assignments_info$assignments)) { + + # extract and display error(s) + errors <- dplyr::pull(assignments_info$assignments$errors) %>% paste0(collapse = "\n") + stop(errors) + + # if no assignments found + } else if (assignments_info$assignments_count == 0) { + + message(glue::glue( + "No assignments found in workspace {glue::backtick(workspace)}.", + "If this result is surprising, check the input in the `workspace` parameter.", + .sep = "\n" + )) + + # case 2: handle successfull assignments request + } else if (assignments_info$assignments_count > 0) { + + # page through assignments; compile data + assignments <- purrr::map_dfr( + .x = seq(from = 0, to =assignments_info$assignments_count , by = chunk_size), # + .f = ~ get_assignments_by_chunk_gql( + workspace = workspace, + where=where_filter, + take_n = chunk_size, + skip_n = .x, + nodes = nodes, + archived = archived, + server = server, + user = user, + password = password + ) + ) + + return(assignments) + + } + +} + + diff --git a/R/maps.R b/R/maps.R new file mode 100644 index 0000000..6f37be7 --- /dev/null +++ b/R/maps.R @@ -0,0 +1,590 @@ +#' Get total count of maps uploaded in workspace +#' +#' @param server Character. Full server web address (e.g., \code{https://demo.mysurvey.solutions}, \code{https://my.domain}) +#' @param workspace Character. Name of the workspace whose maps to get. In workspace list, value of `NAME`, not `DISPLAY NAME`, for the target workspace. +#' @param user Character. API or admin user name for user that access to the workspace. +#' @param password Character. API or admin password +#' +#' @return List consisting of two element: maps request information and map count +#' +#' @import ghql +#' @importFrom jsonlite base64_enc fromJSON +#' @importFrom glue glue double_quote +#' +#' @noRd + + +get_maps_count <- function( + server = Sys.getenv("SUSO_SERVER"), # full server address + workspace = Sys.getenv("SUSO_WORKSPACE"), + user = Sys.getenv("SUSO_USER"), # API user name + password = Sys.getenv("SUSO_PASSWORD") # API password +) { + + # compose the GraphQL request client + maps_request <- ghql::GraphqlClient$new( + url = paste0(server, "/graphql"), + headers = list(authorization = paste0( + "Basic ", jsonlite::base64_enc(input = paste0(user, ":", password))) + ) + ) + + # compose the query for all maps + # use string interpolation to pipe double-quoted workspace name into query + qry <- ghql::Query$new() + qry$query("maps", + glue::glue("{ + maps ( + workspace: + take: 1 + skip: 0 + ) { + filteredCount + } + }", .open = "<", .close = ">") + ) + + # send request + maps_result <- maps_request$exec(qry$queries$maps) + + # convert JSON payload to data frame + maps <- jsonlite::fromJSON(maps_result, flatten = TRUE) + + # extract total number of maps + maps_count <- maps$data$maps$filteredCount + + maps_info <- list(maps = maps, maps_count = maps_count) + + return(maps_info) + +} + + +#' Get chunk of maps uploaded in workspace returned from the server +#' +#' @param take_n Numeric. Number of maps to take in one request. +#' @param skip_n Numeric. Number of maps to skip when paging through results. +#' @param nodes Character vector. Names of attributes to fetch for each map +#' @param server Character. Full server web address (e.g., \code{https://demo.mysurvey.solutions}, \code{https://my.domain}) +#' @param workspace Character. Name of the workspace whose maps to get. In workspace list, value of `NAME`, not `DISPLAY NAME`, for the target workspace. +#' @param user Character. API or admin user name for user that access to the workspace. +#' @param password Character. API or admin password +#' +#' @return Data frame. Maps +#' +#' @import ghql +#' @importFrom jsonlite base64_enc fromJSON +#' @importFrom glue glue double_quote backtick +#' @importFrom dplyr `%>%` pull select rename_with starts_with left_join group_by summarize +#' @importFrom purrr map_if discard map_int +#' @importFrom rlang .data is_empty +#' @importFrom tibble as_tibble +#' @importFrom tidyr unnest pivot_wider +#' +#' @noRd + + +get_maps_by_chunk <- function( + take_n = 100, + skip_n = 0, + nodes = c( + "fileName", + "size", + "users", + "importDateUtc", + "xMaxVal", + "yMaxVal", + "xMinVal", + "yMinVal", + "wkid", + "maxScale", + "minScale" + ), + server = Sys.getenv("SUSO_SERVER"), # full server address + workspace = Sys.getenv("SUSO_WORKSPACE"), + user = Sys.getenv("SUSO_USER"), # API user name + password = Sys.getenv("SUSO_PASSWORD") # API password +) { + + + # determine whether requested identifying data + has_users <- "users" %in% nodes + + # compose the GraphQL request client + maps_request<- ghql::GraphqlClient$new( + url = paste0(server, "/graphql"), + headers = list(authorization = paste0( + "Basic ", jsonlite::base64_enc(input = paste0(user, ":", password))) + ) + ) + + # expand users node if relevant + if (has_users) { + nodes[which(nodes == "users")] <- + "users { + userName + }" + } + + # expand users node if relevant + # compose the query for all maps + # use string interpolation to pipe double-quoted workspace name into query + qry <- ghql::Query$new() + qry$query("maps", + stringr::str_squish((glue::glue("{ + maps ( + workspace: + take: + skip: + ) { + nodes { + + } + filteredCount + } + }", .open = "<", .close = ">"))) + ) + + # send request + maps_result <- maps_request$exec(qry$queries$maps) + + # convert JSON payload to data frame + maps <- jsonlite::fromJSON(maps_result, flatten = TRUE) + + # extract number of maps returned in request + maps_count <- maps$data$maps$filteredCount + + if ("errors" %in% names(maps)) { + + # extract and display error(s) + errors <- dplyr::pull(maps$errors) %>% paste0(collapse = "\n") + stop(errors) + + } else if (maps_count == 0) { + + message(glue::glue( + "No maps found in workspace {glue::backtick(workspace)}.", + "If this result is surprising, check the input in the `workspace` parameter.", + .sep = "\n" + )) + + } else if (maps_count > 0) { + + # extract map data payload + maps_df <- maps$data$maps$nodes %>% + purrr::map_if(is.data.frame, list) %>% + tibble::as_tibble() + + #Check if any user assigned + any_user <- any(lapply(maps_df$users, length)>0) + + + if (has_users & any_user) { + + # extract maps attributes from the payload + id_cols <- names(maps_df) %in% c("users") + maps_attribs_df <- dplyr::select(maps_df, -.data$users) + + # extract (nested) identifying data + users_df <- maps_df %>% + dplyr::select(.data$fileName, .data$users) %>% + purrr::discard(rlang::is_empty) %>% + purrr::map_if(is.data.frame, list) %>% + tibble::as_tibble() %>% + tidyr::unnest(.data$users) %>% + #Reshape to match SuSo format + dplyr::group_by(fileName) %>% + dplyr::summarize(users = paste(userName, collapse = ',')) + + # combine map attributes and identifying data + map_list_df <- maps_attribs_df %>% + dplyr::left_join(users_df, by = "fileName") + } else if (has_users & any_user==FALSE) { + map_list_df <- maps_df + map_list_df['users'] <- NA_character_ + } else if (has_users == FALSE) { + + map_list_df <- maps_df + + } + + return(map_list_df) + + } + +} + +#' Get maps +#' +#' Get list of maps uploaded to workspace and their attributes +#' +#' GraphQL implementation of `maps(...)` endpoint. +#' +#' @param nodes Character vector. Names of attributes to fetch for each map +#' @param chunk_size Numeric. Number of records to take in one request. +#' @param server Character. Full server web address (e.g., \code{https://demo.mysurvey.solutions}, \code{https://my.domain}) +#' @param workspace Character. Name of the workspace whose maps to get. In workspace list, value of `NAME`, not `DISPLAY NAME`, for the target workspace. +#' @param user Character. API or admin user name for user that access to the workspace. +#' @param password Character. API or admin password +#' +#' @return Data frame of maps and their (user-specified) attributes. +#' +#' @importFrom assertthat assert_that +#' @importFrom purrr map_dfr +#' +#' @export + + +get_maps <- function( + nodes = c( + "fileName", + "size", + "users", + "importDateUtc", + "xMaxVal", + "yMaxVal", + "xMinVal", + "yMinVal", + "wkid", + "maxScale", + "minScale" + ), + chunk_size = 100, + server = Sys.getenv("SUSO_SERVER"), # full server address + workspace = Sys.getenv("SUSO_WORKSPACE"), + user = Sys.getenv("SUSO_USER"), # API user name + password = Sys.getenv("SUSO_PASSWORD") # API password +) { + + # check inputs + + # workspace: + # - invalid name + # - workspace does not exist + check_workspace_param(workspace = workspace) + + # nodes in known list + nodes_allowed = c( + "fileName", + "size", + "users", + "importDateUtc", + "xMaxVal", + "yMaxVal", + "xMinVal", + "yMinVal", + "wkid", + "maxScale", + "minScale" + ) + + assertthat::assert_that( + all(nodes %in% nodes_allowed), + msg = "Invalid node listed in `node`. See documentation for allowed nodes." + ) + + # nodes must contain `fileName` + if (!"fileName" %in% nodes) { + stop("The requested nodes must contain `fileName`.") + } + + # get total count of maps + maps_info <- get_maps_count( + workspace = workspace, + server = server, + user = user, + password = password + ) + + # case 1: handle "errors" + # if request returns errors + if ("errors" %in% names(maps_info$maps)) { + + # extract and display error(s) + errors <- dplyr::pull(maps_info$maps$errors) %>% paste0(collapse = "\n") + stop(errors) + + # if no maps found + } else if (maps_info$maps_count == 0) { + + message(glue::glue( + "No maps found in workspace {glue::backtick(workspace)}.", + "If this result is surprising, check the input in the `workspace` parameter.", + .sep = "\n" + )) + + # case 2: handle successfull maps request + } else if (maps_info$maps_count > 0) { + + # page through maps; compile data + maps <- purrr::map_dfr( + .x = seq(from = 0, to = maps_info$maps_count, by = chunk_size), + .f = ~ get_maps_by_chunk( + workspace = workspace, + take_n = chunk_size, + skip_n = .x, + nodes = nodes, + server = server, + user = user, + password = password + ) + ) + + return(maps) + + } + +} + + + +#' Add user to Maps +#' +#' Add an interviewer account ('User') to a map uploaded to workspace +#' +#' GraphQL implementation of `addUserToMap(...)` HeadquartersMutation endpoint. +#' +#' @param mapfile Character. Full name of map file as uploaded to workspace and listed in [HQ-Maps](https://docs.mysurvey.solutions/headquarters/preloading/survey-setup-tab-import-copy-and-delete-questionnaire-templates-and-create-assignments/#maps). Include file extension ('.tpk', '.mmpk' or '.tiff') +#' @param mapuser Character. Full name of interviewer account to be added to \code{mapfile} +#' @param server Character. Full server web address (e.g., \code{https://demo.mysurvey.solutions}, \code{https://my.domain}) +#' @param workspace Character. Name of the workspace in which map is located. In workspace list, value of `NAME`, not `DISPLAY NAME`, for the target workspace. +#' @param user Character. API or admin user name for user that access to the workspace. +#' @param password Character. API or admin password +#' +#' @importFrom assertthat assert_that +#' +#' @return Data frame of map and users linked to it +#' +#' @export + +add_user_to_map <- function( + mapfile="", + mapuser="", + server = Sys.getenv("SUSO_SERVER"), + workspace = Sys.getenv("SUSO_WORKSPACE"), + user = Sys.getenv("SUSO_USER"), + password = Sys.getenv("SUSO_PASSWORD") +) { + + + #Validate parameters + # Workspace: + check_workspace_param(workspace = workspace) + #Mapfile specified + assertthat::assert_that( + nchar(mapfile)>0, + msg = paste0( + "'mapfile' not specified." + ) + ) + #mapuser specified + assertthat::assert_that( + nchar(mapuser)>0, + msg = paste0( + "'mapuser' not specified." + ) + ) + + + + + #Build Base URL + query_url <- httr::parse_url(server) + #Add GraphQL path + query_url$path <- "graphql" + + #Add Body: The GraphQL mutation. See https://github.com/arthur-shaw/susoapi/issues/28 + #For now, solely return fileName and users + gql_body <- stringr::str_squish((glue::glue('mutation { + addUserToMap( + workspace: , + fileName: + userName: + ) + { + fileName + users { + userName + } + } + }', .open = "<", .close = ">"))) + + #Post request + addUserToMap.request <- httr::POST( + url = query_url, + httr::add_headers( + Authorization = paste0( + "Basic ", jsonlite::base64_enc(input = paste0(user, ":", password)) + ) + ), + body = list(query = gql_body), + encode = "json" + ) + + #Store the response for subsequent analysis + addUserToMap.response <- jsonlite::fromJSON(content(addUserToMap.request, as="text"), flatten = TRUE) + + ##Analysis + #1) Errors + if ("errors" %in% names(addUserToMap.response)) { + # extract and display error(s) + errors <- dplyr::pull(addUserToMap.response$errors) %>% paste0(collapse = "\n") + message(glue::glue( + "Attention: {errors}", + "Empty data frame returned", + .sep = "\n" + )) + #TODO: Is this actually desirable? + result.df <- data.frame( + map = NA_character_, + users = NA_character_, + updateDateUtc=NA_integer_ + ) + #2) Success + } else { + newusers <- paste(addUserToMap.response$data$addUserToMap$users$userName,collapse=",") + message(glue::glue( + "User {glue::backtick(mapuser)} successfully added to map {glue::backtick(mapfile)}.", + .sep = "\n" + )) + + #Return df + result.df <- data.frame( + map = addUserToMap.response$data$addUserToMap$fileName, + users = newusers + ) + } + + return(result.df) + +} + + + + + +#' Delete user from Map +#' +#' Removes an interviewer account ('User') from a map uploaded to workspace +#' +#' GraphQL implementation of `deleteUserFromMap(...)` HeadquartersMutation endpoint. +#' +#' @param mapfile Character. Full name of map file as uploaded to workspace and listed in [HQ-Maps](https://docs.mysurvey.solutions/headquarters/preloading/survey-setup-tab-import-copy-and-delete-questionnaire-templates-and-create-assignments/#maps). Include file extension ('.tpk', '.mmpk' or '.tiff') +#' @param mapuser Character. Full name of interviewer account to be deleted from \code{mapfile} +#' @param server Character. Full server web address (e.g., \code{https://demo.mysurvey.solutions}, \code{https://my.domain}) +#' @param workspace Character. Name of the workspace in which map is located. In workspace list, value of `NAME`, not `DISPLAY NAME`, for the target workspace. +#' @param user Character. API or admin user name for user that access to the workspace. +#' @param password Character. API or admin password +#' +#' @importFrom assertthat assert_that +#' +#' @return Data frame of map and users linked to it +#' +#' @export + + +delete_user_from_map <- function( + mapfile="", + mapuser="", + server = Sys.getenv("SUSO_SERVER"), + workspace = Sys.getenv("SUSO_WORKSPACE"), + user = Sys.getenv("SUSO_USER"), + password = Sys.getenv("SUSO_PASSWORD") +) { + + + #Validate parameters + # Workspace: + check_workspace_param(workspace = workspace) + #Mapfile specified + assertthat::assert_that( + nchar(mapfile)>0, + msg = paste0( + "'mapfile' not specified." + ) + ) + #mapuser specified + assertthat::assert_that( + nchar(mapuser)>0, + msg = paste0( + "'mapuser' not specified." + ) + ) + + + + + #Build Base URL + query_url <- httr::parse_url(server) + #Add GraphQL path + query_url$path <- "graphql" + + #Add Body: The GraphQL mutation. See https://github.com/arthur-shaw/susoapi/issues/28 + #For now, solely return fileName and users + gql_body <- stringr::str_squish((glue::glue('mutation { + deleteUserFromMap( + workspace: , + fileName: + userName: + ) + { + fileName + users { + userName + } + } + }', .open = "<", .close = ">"))) + + #Post request + deleteUserFromMap.request <- httr::POST( + url = query_url, + httr::add_headers( + Authorization = paste0( + "Basic ", jsonlite::base64_enc(input = paste0(user, ":", password)) + ) + ), + body = list(query = gql_body), + encode = "json" + ) + + #Store the response for subsequent analysis + deleteUserFromMap.response <- jsonlite::fromJSON(content(deleteUserFromMap.request, as="text"), flatten = TRUE) + + ##Analysis + #1) Errors + if ("errors" %in% names(deleteUserFromMap.response)) { + # extract and display error(s) + errors <- dplyr::pull(deleteUserFromMap.response$errors) %>% paste0(collapse = "\n") + message(glue::glue( + "Attention: {errors}", + "Empty data frame returned", + .sep = "\n" + )) + #TODO: Is this actually desirable? + result.df <- data.frame( + map = NA_character_, + users = NA_character_, + updateDateUtc=NA_integer_ + ) + #2) Success + } else { + newusers <- paste(deleteUserFromMap.response$data$deleteUserFromMap$users$userName,collapse=",") + message(glue::glue( + "User {glue::backtick(mapuser)} successfully deleted from map {glue::backtick(mapfile)}.", + "Updated list of users: {newusers} ", + .sep = "\n" + )) + + #TODO: Do we actually want to have df returned? + result.df <- data.frame( + map = deleteUserFromMap.response$data$deleteUserFromMap$fileName, + users = newusers, + #TODO: Decide if actually useful. + updateDateUtc=as.POSIXlt(Sys.time(), tz = "UTC") + ) + } + + return(result.df) + +} + diff --git a/_pkgdown.yml b/_pkgdown.yml index 375c21c..322272a 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -124,6 +124,13 @@ reference: contents: - get_export_file +- title: "Maps" + desc: > + Functions for reviewing maps. +- subtitle: "Review" + contents: + - get_maps + - title: "Settings" desc: > Functions for modify the global notice (i.e., the information banner at the top of site). diff --git a/man/add_user_to_map.Rd b/man/add_user_to_map.Rd new file mode 100644 index 0000000..679d455 --- /dev/null +++ b/man/add_user_to_map.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/maps.R +\name{add_user_to_map} +\alias{add_user_to_map} +\title{Add user to Maps} +\usage{ +add_user_to_map( + mapfile = "", + mapuser = "", + server = Sys.getenv("SUSO_SERVER"), + workspace = Sys.getenv("SUSO_WORKSPACE"), + user = Sys.getenv("SUSO_USER"), + password = Sys.getenv("SUSO_PASSWORD") +) +} +\arguments{ +\item{mapfile}{Character. Full name of map file as uploaded to workspace and listed in \href{https://docs.mysurvey.solutions/headquarters/preloading/survey-setup-tab-import-copy-and-delete-questionnaire-templates-and-create-assignments/#maps}{HQ-Maps}. Include file extension ('.tpk', '.mmpk' or '.tiff')} + +\item{mapuser}{Character. Full name of interviewer account to be added to \code{mapfile}} + +\item{server}{Character. Full server web address (e.g., \code{https://demo.mysurvey.solutions}, \code{https://my.domain})} + +\item{workspace}{Character. Name of the workspace in which map is located. In workspace list, value of \code{NAME}, not \verb{DISPLAY NAME}, for the target workspace.} + +\item{user}{Character. API or admin user name for user that access to the workspace.} + +\item{password}{Character. API or admin password} +} +\value{ +Data frame of map and users linked to it +} +\description{ +Add an interviewer account ('User') to a map uploaded to workspace +} +\details{ +GraphQL implementation of \code{addUserToMap(...)} HeadquartersMutation endpoint. +} diff --git a/man/delete_user_from_map.Rd b/man/delete_user_from_map.Rd new file mode 100644 index 0000000..1d0642b --- /dev/null +++ b/man/delete_user_from_map.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/maps.R +\name{delete_user_from_map} +\alias{delete_user_from_map} +\title{Delete user from Map} +\usage{ +delete_user_from_map( + mapfile = "", + mapuser = "", + server = Sys.getenv("SUSO_SERVER"), + workspace = Sys.getenv("SUSO_WORKSPACE"), + user = Sys.getenv("SUSO_USER"), + password = Sys.getenv("SUSO_PASSWORD") +) +} +\arguments{ +\item{mapfile}{Character. Full name of map file as uploaded to workspace and listed in \href{https://docs.mysurvey.solutions/headquarters/preloading/survey-setup-tab-import-copy-and-delete-questionnaire-templates-and-create-assignments/#maps}{HQ-Maps}. Include file extension ('.tpk', '.mmpk' or '.tiff')} + +\item{mapuser}{Character. Full name of interviewer account to be deleted from \code{mapfile}} + +\item{server}{Character. Full server web address (e.g., \code{https://demo.mysurvey.solutions}, \code{https://my.domain})} + +\item{workspace}{Character. Name of the workspace in which map is located. In workspace list, value of \code{NAME}, not \verb{DISPLAY NAME}, for the target workspace.} + +\item{user}{Character. API or admin user name for user that access to the workspace.} + +\item{password}{Character. API or admin password} +} +\value{ +Data frame of map and users linked to it +} +\description{ +Removes an interviewer account ('User') from a map uploaded to workspace +} +\details{ +GraphQL implementation of \code{deleteUserFromMap(...)} HeadquartersMutation endpoint. +} diff --git a/man/get_assignments_gql.Rd b/man/get_assignments_gql.Rd new file mode 100644 index 0000000..d21649d --- /dev/null +++ b/man/get_assignments_gql.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assignments_gql.R +\name{get_assignments_gql} +\alias{get_assignments_gql} +\title{Get all assignments} +\usage{ +get_assignments_gql( + qnr_id = "", + qnr_version = NULL, + nodes = c("archived", "createdAtUtc", "email", "id", "interviewsNeeded", + "receivedByTabletAtUtc", "responsibleId", "webMode", "calendarEvent"), + assignment.ids = NULL, + archived = FALSE, + chunk_size = 100, + server = Sys.getenv("SUSO_SERVER"), + workspace = Sys.getenv("SUSO_WORKSPACE"), + user = Sys.getenv("SUSO_USER"), + password = Sys.getenv("SUSO_PASSWORD") +) +} +\arguments{ +\item{qnr_id}{Questionnaire ID. GUID provided by the server.} + +\item{qnr_version}{Questionnaire version. Version number provided by the server.} + +\item{nodes}{Character vector. Names of attributes to fetch for each map} + +\item{assignment.ids}{List with named object 'in' or 'nin' which contains assignment ids to be filtered.} + +\item{archived}{Query archived or non-archived assignments} + +\item{chunk_size}{Numeric. Number of records to take in one request.} + +\item{server}{Full server web address (e.g., \code{https://demo.mysurvey.solutions}, \code{https://my.domain})} + +\item{workspace}{Character. Name of the workspace whose assignments to get. In workspace list, value of \code{NAME}, not \verb{DISPLAY NAME}, for the target workspace.} + +\item{user}{User name} + +\item{password}{Password} +} +\value{ +Data frame of all assignments that meet search criteria. +} +\description{ +Get all assignments for query parameters. (Preliminary) GraphQL implementation of \code{assignments(...)} endpoint. +} diff --git a/man/get_maps.Rd b/man/get_maps.Rd new file mode 100644 index 0000000..174eda6 --- /dev/null +++ b/man/get_maps.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/maps.R +\name{get_maps} +\alias{get_maps} +\title{Get maps} +\usage{ +get_maps( + nodes = c("fileName", "size", "users", "importDateUtc", "xMaxVal", "yMaxVal", + "xMinVal", "yMinVal", "wkid", "maxScale", "minScale"), + chunk_size = 100, + server = Sys.getenv("SUSO_SERVER"), + workspace = Sys.getenv("SUSO_WORKSPACE"), + user = Sys.getenv("SUSO_USER"), + password = Sys.getenv("SUSO_PASSWORD") +) +} +\arguments{ +\item{nodes}{Character vector. Names of attributes to fetch for each map} + +\item{chunk_size}{Numeric. Number of records to take in one request.} + +\item{server}{Character. Full server web address (e.g., \code{https://demo.mysurvey.solutions}, \code{https://my.domain})} + +\item{workspace}{Character. Name of the workspace whose maps to get. In workspace list, value of \code{NAME}, not \verb{DISPLAY NAME}, for the target workspace.} + +\item{user}{Character. API or admin user name for user that access to the workspace.} + +\item{password}{Character. API or admin password} +} +\value{ +Data frame of maps and their (user-specified) attributes. +} +\description{ +Get list of maps uploaded to workspace and their attributes +} +\details{ +GraphQL implementation of \code{maps(...)} endpoint. +}