Craig Williams
0a648f92f0
- Fixed hover style of selected table row - Fixed loading and saving of db actuals location - Fixed approved checks for organsiations - Fixed what_if name for application state
387 lines
12 KiB
R
387 lines
12 KiB
R
#' @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,
|
|
what_if = 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
|
|
)
|
|
}
|
|
)
|
|
)
|