From 21c15a4f0d899bb1063ce1fe824d570cbcdb1b82 Mon Sep 17 00:00:00 2001 From: Craig Williams Date: Wed, 4 Feb 2026 09:57:09 +0000 Subject: [PATCH] Added DB classes --- .Rbuildignore | 1 + .lintr | 2 + DESCRIPTION | 5 + NAMESPACE | 12 ++ R/aaa.R | 6 + R/db.R | 21 +++ R/db_actuals.R | 200 ++++++++++++++++++++++ R/db_applications.R | 386 +++++++++++++++++++++++++++++++++++++++++++ R/db_geometries.R | 89 ++++++++++ R/db_organisations.R | 191 +++++++++++++++++++++ R/db_users.R | 38 +++++ R/utils-pipe.R | 14 ++ man/pipe.Rd | 20 +++ 13 files changed, 985 insertions(+) create mode 100644 .lintr create mode 100644 R/aaa.R create mode 100644 R/db.R create mode 100644 R/db_actuals.R create mode 100644 R/db_applications.R create mode 100644 R/db_geometries.R create mode 100644 R/db_organisations.R create mode 100644 R/db_users.R create mode 100644 R/utils-pipe.R create mode 100644 man/pipe.Rd diff --git a/.Rbuildignore b/.Rbuildignore index 2a2cb83..cd97357 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,2 +1,3 @@ ^LICENSE\.md$ ^README\.Rmd$ +^\.lintr$ diff --git a/.lintr b/.lintr new file mode 100644 index 0000000..2b6ae0e --- /dev/null +++ b/.lintr @@ -0,0 +1,2 @@ +linters: linters_with_defaults(pipe_consistency_linter=pipe_consistency_linter("%>%"), object_name_linter=object_name_linter(c("camelCase", "snake_case", "symbols"), c(enum = "^E_[A-Z_]+$",sf_object_camelCase = "^(?:\\.)?[[:lower:]](?:[[:alnum:]])*(?:\\.sf|\\.sfc|\\.sfproj)(?:[0-9]*)$", sf_object_snake_case = "^(?:\\.)?[[:lower:][:digit:]]+[_[:lower:][:digit:]]*(?:\\.sf|\\.sfc|\\.sfproj)(?:[0-9]*)$"))) # see vignette("lintr") +encoding: "UTF-8" diff --git a/DESCRIPTION b/DESCRIPTION index f7691b1..5b9a2a3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,3 +9,8 @@ License: GPL (>= 3) Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.3 +Imports: + AVSDevR.DBClient, + dplyr, + magrittr, + R6 diff --git a/NAMESPACE b/NAMESPACE index 6ae9268..8eee395 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,2 +1,14 @@ # Generated by roxygen2: do not edit by hand +export("%>%") +export(MNR.DB) +export(MNR.DB.Actuals) +export(MNR.DB.Applications) +export(MNR.DB.Geometries) +export(MNR.DB.Organisations) +export(MNR.DB.Users) +import(dplyr) +importFrom(AVSDevR.DBClient,DBClient) +importFrom(AVSDevR.DBClient,DBConnection) +importFrom(R6,R6Class) +importFrom(magrittr,"%>%") diff --git a/R/aaa.R b/R/aaa.R new file mode 100644 index 0000000..6c859b6 --- /dev/null +++ b/R/aaa.R @@ -0,0 +1,6 @@ + +#' @importFrom AVSDevR.DBClient DBConnection +#' @importFrom AVSDevR.DBClient DBClient +#' @importFrom R6 R6Class +#' @import dplyr +NULL diff --git a/R/db.R b/R/db.R new file mode 100644 index 0000000..4a22895 --- /dev/null +++ b/R/db.R @@ -0,0 +1,21 @@ +#' @export +# nolint next: object_name_linter. R6Class +MNR.DB <- R6::R6Class( + "MNR.DB", + public = list( + initialize = function(db_client) { + if (is.null(db_client) || !inherits(db_client, "DBClient")) { + rlang::abort( + "db_client is not an instance of AVSDevR.DBClient::DBClient!" + ) + } + private$db_client <- db_client + }, + getDBClient = function() { + private$db_client + } + ), + private = list( + db_client = NULL + ) +) diff --git a/R/db_actuals.R b/R/db_actuals.R new file mode 100644 index 0000000..6dad327 --- /dev/null +++ b/R/db_actuals.R @@ -0,0 +1,200 @@ +#' @export +# nolint next: object_name_linter. R6Class +MNR.DB.Actuals <- R6::R6Class( + "MNR.DB.Actuals", + inherit = MNR.DB, + public = list( + selectActuals = function(refs) { + cat("Actuals:\n") + private$db_client$table("actual_activities") %>% + dplyr::filter(proposed_activity_ref %in% !!refs) %>% + dplyr::left_join( + private$db_client$table("locations"), by = c(location_id = "id") + ) %>% + dplyr::left_join( + private$db_client$table("location_blocks"), by = "location_id" + ) %>% + dplyr::select( + proposed_activity_ref, + location_id, + block = block_ref, + geom, + date = occurrence_date + ) %>% + dplyr::collect() %>% + dplyr::glimpse() + }, + selectProposedActuals = function(refs) { + partA <- private$db_client$table("proposed_activities") %>% + dplyr::filter(ref %in% !!refs) %>% + dplyr::select(ref, application_id) %>% + dplyr::left_join( + private$db_client$table("applications") %>% + dplyr::select(id, location_id), + by = c(application_id = "id") + ) %>% + dplyr::inner_join( + private$db_client$table("locations") %>% + dplyr::filter( + (area_type == "Coordinates") | (area_type == "O&G Blocks") + ), + by = c(`location_id` = "id") + ) %>% + dplyr::left_join( + private$db_client$table("location_blocks") %>% + dplyr::mutate(area_type = "O&G Blocks"), + by = c("location_id", "area_type") + ) %>% + dplyr::select( + proposed_activity_ref = ref, location_id, block = block_ref, geom + ) %>% + dplyr::collect() %>% + dplyr::transmute( + proposed_activity_ref, + location_id, + block, + date = lubridate::ymd(NA_character_), + geom = geom + ) + partB <- private$db_client$table("proposed_activities") %>% + dplyr::filter(ref %in% !!refs) %>% + dplyr::select(ref, application_id) %>% + dplyr::left_join( + private$db_client$table("applications") %>% + dplyr::select(id, location_id), + by = c(application_id = "id") + ) %>% + dplyr::inner_join( + private$db_client$table("locations") %>% + dplyr::filter(area_type == "Shapefile"), + by = c(`location_id` = "id") + ) %>% + dplyr::select(proposed_activity_ref = ref, location_id, geom) %>% + dplyr::collect() %>% + dplyr::mutate( + geom.sf = sf::st_as_sfc(geom, crs = 4326, EWKB = TRUE) + ) %>% + dplyr::filter( + sf::st_is(geom.sf, "POINT") + | sf::st_is(geom.sf, "MULTIPOINT") + | sf::st_is(geom.sf, "LINESTRING") + ) %>% + dplyr::mutate( + geom = tolower( + sf::st_as_binary(geom.sf, EWKB = TRUE, hex = TRUE, srid = 4326) + ), + geom = set_class(geom, "pq_geometry"), + geom.sf = NULL + ) %>% + dplyr::transmute( + proposed_activity_ref, + location_id, + block = NA_character_, + date = lubridate::ymd(NA_character_), + geom + ) + + cat("Proposed:\n") + dplyr::bind_rows(partA, partB) %>% + dplyr::glimpse() + }, + upsertActuals = function(actuals.sf, geometries) { + if (length(actuals.sf) == 0 || (nrow(actuals.sf) == 0)) { + return(TRUE) + } + + self$deleteActuals(unique(actuals.sf$ref)) + + actuals <- actuals.sf %>% + tibble::as_tibble() %>% + dplyr::mutate( + area_type = dplyr::if_else( + sf::st_is_empty(geom), "O&G Blocks", "Coordinates" + ), + geom = sf::st_as_binary(geom, EWKB = TRUE, hex = TRUE) + ) + + cat("## Inserting locations for actuals\n") + location_rows <- actuals %>% + dplyr::select(area_type, geom) %>% + dplyr::mutate( + geom = dplyr::if_else(area_type == "O&G Blocks", NA_character_, geom) + ) + location_ids <- private$db_client$appendRows( + "locations", location_rows, key_name = "id" + ) + cat("NEW LOCATION ID(s):", paste(location_ids$id, collapse = ","), "\n") + + actuals_w_ids <- location_ids %>% + dplyr::bind_cols(actuals) %>% + dplyr::rename(location_id = id) + + location_blocks <- actuals_w_ids %>% + dplyr::select(location_id, block_ref) + private$db_client$appendRows("location_blocks", location_blocks) + + cat("## Inserting actuals\n") + actuals_rows <- actuals_w_ids %>% + tidyr::unnest(dates) %>% + dplyr::filter(!is.na(dates)) %>% + dplyr::transmute( + proposed_activity_ref = ref, + location_id, + occurrence_date = dates + ) %>% + dplyr::glimpse() + private$db_client$appendRows("actual_activities", actuals_rows) + + cat("## Inserting marine regions\n") + marine_region_rows <- actuals_w_ids %>% + tidyr::unnest(marine_region_ids) %>% + dplyr::select(location_id, marine_region_id) %>% + dplyr::glimpse() + private$db_client$appendRows( + "location_marine_regions", marine_region_rows + ) + + cat("## Inserting location conservation distances\n") + sac_distance_rows <- actuals_w_ids %>% + tidyr::unnest(conservation_area_distances) %>% + dplyr::select(location_id, conservation_area_id, distance_km) %>% + dplyr::mutate( + distance_km = units::drop_units(distance_km), + flag_actual = TRUE + ) %>% + dplyr::glimpse() + private$db_client$appendRows( + "location_conservation_area_distances", sac_distance_rows + ) + + TRUE + }, + deleteActuals = function(refs) { + cat("## Deleting old actuals for", paste(refs, collapse = ","), "\n") + old_references <- private$db_client$table("actual_activities") %>% + dplyr::filter(proposed_activity_ref %in% !!refs) %>% + dplyr::select(map_id, location_id) %>% + dplyr::collect() + + if (nrow(old_references) > 0) { + old_locations <- old_references %>% + dplyr::select(location_id) %>% + dplyr::distinct() + + old_actuals <- old_references %>% + dplyr::select(map_id) %>% + dplyr::distinct() + + private$db_client$deleteRows("actual_activities", old_actuals) + private$db_client$deleteRows("location_marine_regions", old_locations) + private$db_client$deleteRows( + "location_conservation_area_distances", old_locations + ) + private$db_client$deleteRows("location_blocks", old_locations) + private$db_client$deleteRows( + "locations", old_locations %>% dplyr::rename(id = location_id) + ) + } + } + ) +) diff --git a/R/db_applications.R b/R/db_applications.R new file mode 100644 index 0000000..c5612f2 --- /dev/null +++ b/R/db_applications.R @@ -0,0 +1,386 @@ +#' @export +# nolint next: object_name_linter. R6Class +MNR.DB.Applications <- R6::R6Class( + "MNR.DB.Applications", + inherit = MNR.DB, + public = list( + initialize = function(db_client) { + super$initialize(db_client) + private$db_users <- MNR.DB.Users$new(db_client) + private$db_orgs <- MNR.DB.Organisations$new(db_client) + }, + + collectFromPermissions = function(perm_query, collect = TRUE) { + # nolint end + if (getOption("debug", FALSE)) { + cat("collectFromPermissions\n") + } + + private$getFromPermissions(perm_query) %>% + private$joinInfoColumns() %>% + private$joinCloseoutColumns() %>% + private$db_client$collectOrReturn() + }, + + getUnfilteredApplications = function( + as_permissions = FALSE, collect = TRUE + ) { + warning("This method should not be used for production!") + + perm_qry <- private$db_client$table("application_permissions") %>% + dplyr::filter(organisation_id == -1) %>% + dplyr::mutate(is_admin = FALSE) + + class(perm_qry) <- unique(c(class(perm_qry), "permissions_query")) + + if (as_permissions) { + res <- perm_qry %>% + private$db_client$collectOrReturn() + return(res) + } + + self$collectFromPermissions(perm_qry, collect) + }, + + getAdminApplications = function( + user_id = -1, as_permissions = FALSE, collect = TRUE + ) { + if (getOption("debug", FALSE)) { + cat("getPublicOnlyApplications\n") + } + + perm_qry <- private$getApplicationPermissions(user_id) %>% + dplyr::filter(is_admin) + + if (as_permissions) { + res <- perm_qry %>% + private$db_client$collectOrReturn() + return(res) + } + + self$collectFromPermissions(perm_qry, collect) + }, + + getPublicOnlyApplications = function( + user_id = -1, as_permissions = FALSE, collect = TRUE + ) { + if (getOption("debug", FALSE)) { + cat("getPublicOnlyApplications\n") + } + + perm_qry <- private$getApplicationPermissions(user_id) %>% + dplyr::filter(state_public) + + if (as_permissions) { + res <- perm_qry %>% + private$db_client$collectOrReturn() + return(res) + } + + self$collectFromPermissions(perm_qry, collect) + }, + + getRelatedApplications = function( + user_id, as_permissions = FALSE, collect = TRUE + ) { + if (getOption("debug", FALSE)) { + cat("getRelatedApplications :: user_id ==", user_id, "\n") + } + + perm_qry <- private$getApplicationPermissions(user_id) %>% + dplyr::filter(organisation_match) %>% + dplyr::filter( + app_lead | app_agent | app_shared | (app_regulator & state_public) + ) + + if (as_permissions) { + res <- perm_qry %>% + private$db_client$collectOrReturn() + return(res) + } + + self$collectFromPermissions(perm_qry, collect) + }, + + # nolint next: object_length_linter. Descriptive function name + getUserOrganisationApplications = function( + user_id, as_permissions = FALSE, collect = TRUE + ) { + if (getOption("debug", FALSE)) { + cat("getUserOrganisationApplications :: user_id ==", user_id, "\n") + } + + perm_qry <- private$getApplicationPermissions(user_id) %>% + dplyr::filter(organisation_match) %>% + dplyr::filter(app_submitter) + + if (as_permissions) { + res <- perm_qry %>% + private$db_client$collectOrReturn() + return(res) + } + + self$collectFromPermissions(perm_qry, collect) + }, + + getUserApplications = function( + user_id, as_permissions = FALSE, collect = TRUE + ) { + if (getOption("debug", FALSE)) { + cat("getUserApplications :: user_id ==", user_id, "\n") + } + + perm_qry <- private$getApplicationPermissions(user_id) %>% + dplyr::filter( + submitting_user_id == !!user_id + & (state_whatif | organisation_id != -1) + ) + + if (as_permissions) { + res <- perm_qry %>% + private$db_client$collectOrReturn() + return(res) + } + + self$collectFromPermissions(perm_qry, collect) + }, + + getApplicationState = function(application_id, collect = TRUE) { + if (length(application_id) == 0) { + application_id <- -1 + } + state <- private$db_client$table("application_states") %>% + dplyr::filter(application_id == !!application_id) %>% + dplyr::collect() %>% + as.list() + if (sum(lengths(state)) == 0) { + state <- list( + application_id = application_id, + workflow_status = "new", + status = "new", + new = TRUE, + draft = FALSE, + submitted = FALSE, + approved = FALSE, + in_progress = FALSE, + closed = FALSE, + cancelled = FALSE, + deleted = FALSE, + whatif = FALSE, + voluntary = FALSE, + consented = FALSE, + multiyear = FALSE, + public = FALSE + ) + } + state + } + ), + private = list( + db_users = NULL, + db_orgs = NULL, + + getApplicationPermissions = function(user_id = -1) { + org_id <- c(private$db_orgs$getUserOrganisation(user_id), -1)[[1]] + + flag_admin <- private$db_users$isApplicationsAdmin(user_id) + + perm_query <- private$db_client$table("application_permissions") %>% + dplyr::mutate( + organisation_match = organisation_id == !!org_id, + user_match = submitting_user_id == !!user_id, + is_admin = flag_admin + ) %>% + dplyr::filter( + # If organisation is null: + # only get public matches + # else + # get org matches where not what-if + dplyr::if_else( + !!org_id == -1, + (organisation_match & state_public), + (organisation_match & !state_whatif) + ) + # Include user what-ifs + | (user_match & organisation_id == -1 & state_whatif) + # Admin override + | (!!flag_admin & organisation_id == -1) + ) %>% + dplyr::filter( + # Either user is admin or the application is not deleted + !!flag_admin | !state_deleted + ) + + class(perm_query) <- unique(c(class(perm_query), "permissions_query")) + + perm_query + }, + + mutatePermissionsColumns = function(perm_query) { + stopifnot( + "object is not a permissions query" = inherits( + perm_query, "permissions_query" + ) + ) + + # NOTE: can_edit assumes a later check for close-out allowance on closed + # applications + perm_query %>% + dplyr::group_by(application_id) %>% + dplyr::filter(organisation_id == max(organisation_id, -1)) %>% + dplyr::ungroup() %>% + dplyr::transmute( + application_id, + can_admin = is_admin, + can_regulate = app_regulator & state_public, + can_edit = app_submitter + | app_lead + | app_agent + | app_shared + | state_whatif, + can_edit = ((can_edit | can_regulate) & !state_cancelled) | can_admin, + can_read = can_admin | can_edit | state_public, + is_public = state_public, + is_closed = state_closed, + is_whatif = state_whatif + ) %>% + dplyr::distinct() %>% + dplyr::collapse() + }, + + getFromPermissions = function(perm_query) { + # nolint end + stopifnot( + "object is not a permissions query" = inherits( + perm_query, "permissions_query" + ) + ) + + private$db_client$table("application_timestamps") %>% + dplyr::left_join( + private$db_client$table("application_states") %>% + dplyr::select(application_id, status), + by = c(id = "application_id") + ) %>% + dplyr::inner_join( + perm_query %>% + private$mutatePermissionsColumns(), + by = c(id = "application_id") + ) + }, + + getCloseoutDates = function() { + private$db_client$table("application_timestamps") %>% + dplyr::left_join( + private$db_client$table("regulator_closeout_periods") %>% + dplyr::filter(regulator_organisation_id != 7) %>% + dplyr::select(-map_id), + by = c("regulator_organisation_id") + ) %>% + # Work out what the closeout closeout year should be + dplyr::mutate( + closeout_year = as.Date(paste( + lubridate::year(pmax(start_date, closed_at, na.rm = TRUE)), + 12L, + 31L, + sep = "-" + )) + year_closeout_period, + closeout_final = end_date + closeout_period + ) %>% + # If periods are null, set date to the distant future (Inf) + dplyr::transmute( + id, + closeout_period, + year_closeout_period, + closeout_year = dplyr::if_else( + is.null(year_closeout_period), as.Date("2200-01-01"), closeout_year + ), + closeout_final = dplyr::if_else( + is.null(closeout_period), as.Date("2200-01-01"), closeout_final + ) + ) %>% + # If periods are null, set date to the distant future (Inf) + dplyr::transmute( + id, + closeout_due = dplyr::if_else( + closeout_year < closeout_final, closeout_year, closeout_final + ) + ) %>% + dplyr::collapse() + }, + + joinInfoColumns = function(app_query) { + app_query %>% + dplyr::left_join( + private$db_client$table("users") %>% + dplyr::transmute( + id, submitter_name = paste(first_name, last_name) + ) %>% + dplyr::collapse(), + by = c(submitting_user_id = "id") + ) %>% + dplyr::relocate(submitter_name, .after = submitting_user_id) %>% + dplyr::left_join( + private$db_client$table("organisations") %>% + dplyr::select(id, submitting_organisation_name = name) %>% + dplyr::collapse(), + by = c(submitting_organisation_id = "id") + ) %>% + dplyr::relocate( + submitting_organisation_name, .after = submitting_organisation_id + ) %>% + dplyr::left_join( + private$db_client$table("organisations") %>% + dplyr::select(id, lead_organisation_name = name) %>% + dplyr::collapse(), + by = c(lead_organisation_id = "id") + ) %>% + dplyr::relocate( + lead_organisation_name, .after = lead_organisation_id + ) %>% + dplyr::left_join( + private$db_client$table("organisations") %>% + dplyr::select(id, regulator_name = name) %>% + dplyr::collapse(), + by = c(regulator_organisation_id = "id") + ) %>% + dplyr::relocate(regulator_name, .after = regulator_organisation_id) + }, + + joinCloseoutColumns = function(app_query) { + closeout_edit_cutoff <- lubridate::make_date( + lubridate::year(lubridate::today()), 3, 31 + ) + if (lubridate::today() > closeout_edit_cutoff) { + closeout_edit_cutoff <- closeout_edit_cutoff + lubridate::years(1) + } + + app_query %>% + dplyr::left_join(private$getCloseoutDates(), by = "id") %>% + # Work out what the closeout closeout year should be + dplyr::mutate( + closeout_due = dplyr::if_else( + is_closed, as.Date(closed_at), closeout_due + ) + ) %>% + # Work out if the closed application is beyond the edit date + dplyr::mutate( + edit_cutoff_date = as.Date(paste( + lubridate::year(closeout_due), 3L, 31L, sep = "-" + )), + edit_cutoff_next = as.Date(paste( + lubridate::year(closeout_due) + 1L, 3L, 31L, sep = "-" + )), + edit_cutoff = dplyr::if_else( + edit_cutoff_date < closeout_due, edit_cutoff_next, edit_cutoff_date + ), + can_edit_closed = dplyr::if_else( + is_closed & (edit_cutoff <= lubridate::now()), can_admin, can_edit + ) + ) %>% + dplyr::select( + -edit_cutoff_date, -edit_cutoff_next, -edit_cutoff + ) + } + ) +) diff --git a/R/db_geometries.R b/R/db_geometries.R new file mode 100644 index 0000000..6607ebc --- /dev/null +++ b/R/db_geometries.R @@ -0,0 +1,89 @@ +#' @export +# nolint next: object_name_linter. R6Class +MNR.DB.Geometries <- R6::R6Class( + "MNR.DB.Geometries", + inherit = MNR.DB, + public = list( + getBlocks = function( + with_geometries = TRUE, ordered = FALSE, collect = TRUE + ) { + qry <- private$db_client$table("blocks") + + if (ordered) { + qry <- qry %>% + dplyr::mutate( + block_ref_num = stringr::str_replace_all( + block_ref, "[A-Z]+/", "999/" + ), + block_ref_let = stringr::str_replace_all( + block_ref, "[0-9]+/", "A/" + ), + block_order_A = as.integer(stringr::str_replace_all( + block_ref_num, "/[0-9]+", "" + )), + block_order_B = stringr::str_replace_all( + block_ref_let, "/[0-9]+", "" + ), + block_order_C = as.integer(stringr::str_replace_all( + block_ref, "[A-Z0-9]+/", "" + )) + ) %>% + dplyr::collapse() %>% + dbplyr::window_order(block_order_A, block_order_B, block_order_C) %>% + dplyr::collapse() + } + + if (!with_geometries) { + qry <- qry %>% + dplyr::select(-dplyr::any_of(c("geometry", "proj", "geom"))) %>% + private$db_client$collectOrReturn() + } else if (collect) { + qry <- qry %>% + private$db_client$collectGeometries() + } + + qry + }, + + getConservationAreas = function(with_geometries = TRUE, collect = TRUE) { + qry <- private$db_client$table("conservation_areas") + + if (!with_geometries) { + qry <- qry %>% + dplyr::select(-dplyr::any_of(c("geometry", "proj", "geom"))) %>% + private$db_client$collectOrReturn() + } else if (collect) { + qry <- qry %>% + private$db_client$collectGeometries() + } + + qry + }, + + getMarineRegions = function(with_geometries = TRUE, collect = TRUE) { + qry <- private$db_client$table("marine_regions") + + if (!with_geometries) { + qry <- qry %>% + dplyr::select(-dplyr::any_of(c("geometry", "proj", "geom"))) %>% + private$db_client$collectOrReturn() + } else if (collect) { + qry <- qry %>% + private$db_client$collectGeometries() + } + + qry + }, + + getBlockMarineRegions = function(collect = TRUE) { + qry <- private$db_client$table("block_marine_regions") + private$db_client$collectOrReturn(qry) + }, + + # nolint next: object_length_linter. Descriptive function name required + getBlockConservationAreaDistances = function(collect = TRUE) { + qry <- private$db_client$table("block_conservation_area_distances") + private$db_client$collectOrReturn(qry) + } + ) +) diff --git a/R/db_organisations.R b/R/db_organisations.R new file mode 100644 index 0000000..eef039b --- /dev/null +++ b/R/db_organisations.R @@ -0,0 +1,191 @@ +#' @export +# nolint next: object_name_linter. R6Class +MNR.DB.Organisations <- R6::R6Class( + "MNR.DB.Organisations", + inherit = MNR.DB, + public = list( + getOrganisation = function(org_id, collect = TRUE) { + private$db_client$table("organisations") %>% + dplyr::filter(id == !!org_id) %>% + private$db_client$collectOrReturn() + }, + + getAllOrganisations = function( + as_int = FALSE, name_only = TRUE, collect = TRUE + ) { + qry <- private$db_client$table("organisations") %>% + dplyr::filter(flag_approved == TRUE) + + if (as_int) { + qry %>% + dplyr::pull(id) + } else if (name_only) { + qry %>% + dplyr::pull(name) + } else { + qry %>% + private$db_client$collectOrReturn() + } + }, + + isRegulator = function(org_id) { + private$db_client$table("organisations") %>% + dplyr::filter(flag_approved == TRUE) %>% + dplyr::filter(flag_regulator == TRUE) %>% + dplyr::filter(id == !!org_id) %>% + dplyr::count() %>% + dplyr::pull() %>% + magrittr::is_greater_than(0) + }, + + getRegulators = function(as_int = FALSE, name_only = TRUE, collect = TRUE) { + qry <- private$db_client$table("organisations") %>% + dplyr::filter(flag_approved == TRUE) %>% + dplyr::filter(flag_regulator == TRUE) + + if (as_int) { + qry %>% + dplyr::pull(id) + } else if (name_only) { + qry %>% + dplyr::pull(name) + } else { + qry %>% + private$db_client$collectOrReturn() + } + }, + + getUsersFromOrg = function(org_name = "", org_id = -1, collect = TRUE) { + private$db_client$table("users") %>% + dplyr::filter(flag_enabled == TRUE, flag_verified == TRUE) %>% + dplyr::mutate(known_as = paste(first_name, last_name)) %>% + dplyr::left_join( + private$db_client$table("organisation_members") %>% + dplyr::select(user_id, organisation_id), + by = c(id = "user_id") + ) %>% + dplyr::inner_join( + private$db_client$table("organisations") %>% + dplyr::filter((id == !!org_id) | (name == !!org_name)) %>% + dplyr::select(id), + by = c(organisation_id = "id") + ) %>% + dplyr::select(-organisation_id) %>% + private$db_client$collectOrReturn() + }, + + isAgent = function(user_id) { + private$db_client$table("organisation_members") %>% + dplyr::filter(user_id == !!user_id) %>% + dplyr::inner_join( + private$db_client$table("organisation_agents") %>% + dplyr::filter(flag_approved == TRUE), + by = c(organisation_id = "agent_id") + ) %>% + dplyr::count() %>% + dplyr::pull() %>% + magrittr::is_greater_than(0) + }, + + getAgentForOrganisations = function( + org_ids, as_int = FALSE, name_only = TRUE, collect = TRUE + ) { + qry <- private$db_client$table("organisations") %>% + dplyr::filter(flag_approved == TRUE) %>% + dplyr::inner_join( + private$db_client$table("organisation_agents") %>% + dplyr::filter(organisation_id %in% !!org_ids) %>% + dplyr::select(agent_id) %>% + dplyr::collapse(), + by = c(id = "agent_id") + ) %>% + dplyr::distinct() + + if (as_int) { + qry %>% + dplyr::pull(id) + } else if (name_only) { + qry %>% + dplyr::pull(name) + } else { + qry %>% + private$db_client$collectOrReturn() + } + }, + + getRecipientOrganisations = function( + org_id, as_int = FALSE, name_only = TRUE, collect = TRUE + ) { + qry <- private$db_client$table("organisations") %>% + dplyr::filter(flag_approved == TRUE) %>% + dplyr::inner_join( + private$db_client$table("organisation_agents") %>% + dplyr::filter(agent_id %in% !!org_id) %>% + dplyr::select(organisation_id) %>% + dplyr::collapse(), + by = c(id = "organisation_id") + ) %>% + dplyr::distinct() + + if (as_int) { + qry %>% + dplyr::pull(id) + } else if (name_only) { + qry %>% + dplyr::pull(name) + } else { + qry %>% + private$db_client$collectOrReturn() + } + }, + + getUserOrgs = function( + user_id, as_int = TRUE, name_only = TRUE, collect = TRUE + ) { + qry <- private$db_client$table("organisations") %>% + dplyr::left_join( + private$db_client$table("organisation_members") %>% + dplyr::select(user_id, organisation_id), + by = c(id = "organisation_id") + ) %>% + dplyr::filter(flag_approved == TRUE) %>% + dplyr::filter(user_id == !!user_id) + + if (as_int) { + qry %>% + dplyr::pull(id) + } else if (name_only) { + qry %>% + dplyr::pull(name) + } else { + qry %>% + private$db_client$collectOrReturn() + } + }, + + getUserOrganisation = function( + user_id, as_int = TRUE, name_only = TRUE, collect = TRUE + ) { + qry <- private$db_client$table("organisations") %>% + dplyr::left_join( + private$db_client$table("organisation_members") %>% + dplyr::select(user_id, organisation_id), + by = c(id = "organisation_id") + ) %>% + dplyr::filter(flag_approved == TRUE) %>% + dplyr::filter(user_id == !!user_id) %>% + dplyr::slice_min(user_id, n = 1) + + if (as_int) { + qry %>% + dplyr::pull(id) + } else if (name_only) { + qry %>% + dplyr::pull(name) + } else { + qry %>% + private$db_client$collectOrReturn() + } + } + ) +) diff --git a/R/db_users.R b/R/db_users.R new file mode 100644 index 0000000..fbba3c9 --- /dev/null +++ b/R/db_users.R @@ -0,0 +1,38 @@ +#' @export +# nolint next: object_name_linter. R6Class +MNR.DB.Users <- R6::R6Class( + "MNR.DB.Users", + inherit = MNR.DB, + public = list( + initialize = function(db_client, admin_role_slug = NULL) { + super$initialize(db_client) + private$db_uf <- AVSDevR.UserFrosting::UFDatabase$new(db_client) + + if (!is.null(admin_role_slug)) { + private$admin_role_slug <- admin_role_slug + } + }, + + getUser = function(user_id, collect = TRUE) { + db_uf$getUser(user_id, collect) + }, + getUserName = function(user_id) { + db_uf$getUserName(user_id) + }, + getUserRoles = function(user_id, collect = TRUE) { + db_uf$getUserRoles(user_id, collect) + }, + + isApplicationsAdmin = function(user_id) { + self$getUserRoles(user_id, collect = FALSE) %>% + dplyr::filter(slug == !!private$admin_role_slug) %>% + dplyr::count() %>% + dplyr::pull(n) %>% + magrittr::is_greater_than(0) + } + ), + private = list( + db_uf = NULL, + admin_role_slug = "application-admin" + ) +) diff --git a/R/utils-pipe.R b/R/utils-pipe.R new file mode 100644 index 0000000..fd0b1d1 --- /dev/null +++ b/R/utils-pipe.R @@ -0,0 +1,14 @@ +#' Pipe operator +#' +#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +#' +#' @name %>% +#' @rdname pipe +#' @keywords internal +#' @export +#' @importFrom magrittr %>% +#' @usage lhs \%>\% rhs +#' @param lhs A value or the magrittr placeholder. +#' @param rhs A function call using the magrittr semantics. +#' @return The result of calling `rhs(lhs)`. +NULL diff --git a/man/pipe.Rd b/man/pipe.Rd new file mode 100644 index 0000000..a648c29 --- /dev/null +++ b/man/pipe.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-pipe.R +\name{\%>\%} +\alias{\%>\%} +\title{Pipe operator} +\usage{ +lhs \%>\% rhs +} +\arguments{ +\item{lhs}{A value or the magrittr placeholder.} + +\item{rhs}{A function call using the magrittr semantics.} +} +\value{ +The result of calling \code{rhs(lhs)}. +} +\description{ +See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +} +\keyword{internal}