Added DB classes

.Rbuildignore

@@ -1,2 +1,3 @@
 ^LICENSE\.md$
 ^README\.Rmd$
+^\.lintr$

.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"

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

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,"%>%")

R/aaa.R

@@ -0,0 +1,6 @@
+
+#' @importFrom AVSDevR.DBClient DBConnection
+#' @importFrom AVSDevR.DBClient DBClient
+#' @importFrom R6 R6Class
+#' @import dplyr
+NULL

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
+  )
+)

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)
+        )
+      }
+    }
+  )
+)

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
+        )
+    }
+  )
+)

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)
+    }
+  )
+)

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()
+      }
+    }
+  )
+)

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"
+  )
+)

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

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}