Merge pull request #171 from saipavan10-git/improve_logging_in_deletes

Improve logging in project deletes

.github/workflows/run-tests.yaml

@@ -15,10 +15,45 @@ jobs:
 
     env:
       CI: "TRUE"
+      R_LIBS_USER: /github/home/R/x86_64-pc-linux-gnu-library/4.4
+      R_LIB_FOR_PAK: /usr/local/lib/R/site-library
 
     steps:
       - uses: actions/checkout@v2
 
-      - name: Check
+      # Create directories for R libraries if not already present
+      - name: Create R Library Paths
+        run: |
+          mkdir -p /github/home/R/x86_64-pc-linux-gnu-library/4.4
+          mkdir -p renv/library
+
+      # Restore cache for R dependencies
+      - name: Restore R Dependencies Cache
+        uses: actions/cache@v4
+        with:
+          path: |
+            /github/home/R/x86_64-pc-linux-gnu-library/4.4
+            renv/library
+          key: ${{ runner.os }}-r-libs-${{ hashFiles('DESCRIPTION') }}
+          restore-keys: |
+            ${{ runner.os }}-r-libs-
+
+      # Install R dependencies
+      - name: Install R Dependencies
+        uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          cache: false
+
+      # Run tests
+      - name: Run Tests
         run: devtools::test(stop_on_failure = TRUE)
         shell: Rscript {0}
+
+      # Save R dependencies to cache
+      - name: Save R Dependencies Cache
+        uses: actions/cache@v4
+        with:
+          path: |
+            /github/home/R/x86_64-pc-linux-gnu-library/4.4
+            renv/library
+          key: ${{ runner.os }}-r-libs-${{ hashFiles('DESCRIPTION') }}

DESCRIPTION

@@ -61,7 +61,8 @@ Imports:
     vctrs,
     jsonlite,
     openxlsx,
-    quarto
+    quarto,
+    getip
 Suggests:
     RSQLite,
     digest,

Dockerfile

@@ -28,6 +28,7 @@ RUN R -e "install.packages(c( \
   'writexl', \
   'openxlsx', \
   'kableExtra' \
+  'getip' \
 ))"
 
 RUN R -e "devtools::install_github('allanvc/mRpostman')"

R/delete_project.R

@@ -19,12 +19,11 @@
 #' @examples
 #' \dontrun{
 #' conn <- DBI::dbConnect(...)
-#' delete_project(c(1,2,3), conn)
+#' delete_project(c(1, 2, 3), conn)
 #' }
 #' @export
 
 delete_project <- function(project_id, conn) {
-
   redcap_projects <- DBI::dbGetQuery(
     conn,
     sprintf(
@@ -34,47 +33,86 @@ delete_project <- function(project_id, conn) {
         log_event_table
      from redcap_projects
      where project_id in (%s)",
-     paste0(project_id, collapse = ",")
+      paste0(project_id, collapse = ",")
     )
   )
 
-  # select projects for deletion
   projects_to_delete <- redcap_projects[is.na(redcap_projects$date_deleted), ]
   redcap_project_ids <- projects_to_delete$project_id
   redcap_log_tables <- projects_to_delete$log_event_table
 
+
   if (nrow(projects_to_delete) > 0) {
-    tryCatch({
-      deleted_projects <- DBI::dbExecute(
-        conn,
-        sprintf(
-          "update redcap_projects set date_deleted = now() where project_id in (%s)",
-          paste0(redcap_project_ids, collapse = ",")
-        )
-      )
-    }, error = function(error_message) {
-      print(error_message)
-      return(FALSE)
-    })
+    delete_sql <- sprintf(
+      "UPDATE redcap_projects SET date_deleted = NOW() WHERE project_id IN (%s)",
+      paste0(redcap_project_ids, collapse = ",")
+    )
 
-    # log the event
-    tryCatch({
-      inserted_rows <- purrr::map2(
-        redcap_log_tables,
-        redcap_project_ids,
-        ~ DBI::dbExecute(
-          conn,
-          sprintf(
-            "insert into %s (object_type, event, project_id, description)
-             values ('redcap_projects', 'MANAGE', %d, 'delete project')",
-        .x,
-        .y)
+    tryCatch(
+      {
+        deleted_projects <- DBI::dbExecute(conn, delete_sql)
+      },
+      error = function(error_message) {
+        print(error_message)
+        return(FALSE)
+      }
+    )
+
+    # Define logging parameters
+    ts <- format(Sys.time(), "%Y%m%d%H%M%S") # Time stamp
+    user <- ifelse(is.null(get_script_name()), "admin", get_script_name())
+    ip <- getip::getip("local")
+    page <- "rcc.billing::delete_abandoned_projects"
+    event <- "MANAGE"
+    object_type <- "redcap_projects"
+    description <- "Delete project"
+    legacy <- 0
+    change_reason <- NULL
+
+    tryCatch(
+      {
+        inserted_rows <- purrr::map2(
+          redcap_log_tables,
+          redcap_project_ids,
+          ~ {
+            pk <- .y
+            data_values <- sprintf("project_id = %d", .y)
+
+            DBI::dbExecute(
+              conn,
+              sprintf(
+                "INSERT INTO %s
+                (log_event_id, project_id, ts, user, ip, page, event,
+                 object_type, sql_log, pk, event_id, data_values,
+                 description, legacy, change_reason)
+               VALUES
+                (NULL, %d, '%s', '%s', '%s', '%s', '%s',
+                 '%s', '%s', '%d', NULL, '%s',
+                 '%s', %d, %s)",
+                .x, # Log table
+                .y, # Project ID
+                ts,
+                user,
+                ip,
+                page,
+                event,
+                object_type,
+                delete_sql,
+                pk,
+                data_values,
+                description,
+                legacy,
+                ifelse(is.null(change_reason), "NULL", sprintf("'%s'", change_reason))
+              )
+            )
+          }
         )
-      )
-    }, error = function(error_message) {
-      print(error_message)
-      return(FALSE)
-    })
+      },
+      error = function(error_message) {
+        print(error_message)
+        return(FALSE)
+      }
+    )
   } else {
     deleted_projects <- NULL
     inserted_rows <- NULL

tests/testthat/test-delete_project.R

@@ -1,86 +1,135 @@
-# create SQL tables
+library(DBI)
+library(duckdb)
+library(dplyr)
+library(lubridate)
+library(testthat)
+
+# Create SQL tables
 redcap_projects <- data.frame(
   project_id = 1:6,
   date_deleted = c(rep(NA, 5), format(Sys.time() - 86400, "%Y-%m-%d %H:%M:%S")),
-  log_event_table = c(rep('redcap_log_event1', 3), rep('redcap_log_event2', 3))
+  log_event_table = c(rep("redcap_log_event1", 3), rep("redcap_log_event2", 3))
 )
 
 redcap_log_event1 <- data.frame(
-  object_type = NA_character_,
-  event = NA_character_,
+  log_event_id = NA_integer_,
   project_id = NA_integer_,
-  description = NA_character_
-)
-
-redcap_log_event2 <- data.frame(
-  object_type = NA_character_,
+  ts = NA_character_,
+  user = NA_character_,
+  ip = NA_character_,
+  page = NA_character_,
   event = NA_character_,
-  project_id = NA_integer_,
-  description = NA_character_
+  object_type = NA_character_,
+  sql_log = NA_character_,
+  pk = NA_character_,
+  event_id = NA_character_,
+  data_values = NA_character_,
+  description = NA_character_,
+  legacy = NA_integer_,
+  change_reason = NA_character_
 )
 
-# write SQL tables
+redcap_log_event2 <- redcap_log_event1
+
+# Write SQL tables
 conn <- DBI::dbConnect(duckdb::duckdb(), dbname = ":memory:")
 DBI::dbWriteTable(conn, "redcap_projects", redcap_projects)
 DBI::dbWriteTable(conn, "redcap_log_event1", redcap_log_event1)
 DBI::dbWriteTable(conn, "redcap_log_event2", redcap_log_event2)
 
-# create comparison dfs
-expected_redcap_projects <- data.frame(
-  project_id = 1:6,
-  # convert to UTC to prevent test from failing due to timezone differences
-  date_deleted = c(rep(as.Date(lubridate::with_tz(Sys.time(), "UTC")), 5), Sys.Date() - 1),
-  log_event_table = c(rep('redcap_log_event1', 3), rep('redcap_log_event2', 3))
-)
+current_ts <- format(Sys.time(), "%Y%m%d%H%M%S")
+
+# Expected results
+expected_redcap_projects <- redcap_projects |>
+  mutate(
+    date_deleted = if_else(is.na(date_deleted), as.character(as.Date(Sys.time())), date_deleted)
+  )
 
 expected_redcap_log_event1 <- data.frame(
-  object_type = c(NA, rep("redcap_projects", 3)),
-  event = c(NA, rep("MANAGE", 3)),
+  log_event_id = NA_integer_,
   project_id = c(NA, 1:3),
-  description =  c(NA, rep("delete project", 3))
+  ts = c(NA, rep(current_ts, 3)),
+  user = c(NA, rep("admin", 3)),
+  ip = c(NA, rep(getip::getip("local"), 3)),
+  page = c(NA, rep("rcc.billing::delete_abandoned_projects", 3)),
+  event = c(NA, rep("MANAGE", 3)),
+  object_type = c(NA, rep("redcap_projects", 3)),
+  sql_log = c(NA, rep("UPDATE redcap_projects SET date_deleted = NOW() WHERE project_id IN (1,2,3,4,5)", 3)),
+  pk = c(NA, as.character(1:3)),
+  event_id = NA_character_,
+  data_values = c(NA, sprintf("project_id = %d", 1:3)),
+  description = c(NA, rep("Delete project", 3)),
+  legacy = c(NA, rep(0, 3)),
+  change_reason = NA_character_
 )
 
 expected_redcap_log_event2 <- data.frame(
-  object_type = c(NA, rep("redcap_projects", 2)),
+  log_event_id = NA_integer_,
+  project_id = c(NA, 4, 5),
+  ts = c(NA, rep(current_ts, 2)),
+  user = c(NA, rep("admin", 2)),
+  ip = c(NA, rep(getip::getip("local"), 2)),
+  page = c(NA, rep("rcc.billing::delete_abandoned_projects", 2)),
   event = c(NA, rep("MANAGE", 2)),
-  project_id =  c(NA, 4:5),
-  description = c(NA, rep("delete project", 2))
+  object_type = c(NA, rep("redcap_projects", 2)),
+  sql_log = c(NA, rep("UPDATE redcap_projects SET date_deleted = NOW() WHERE project_id IN (1,2,3,4,5)", 2)),
+  pk = c(NA, "4", "5"),
+  event_id = NA_character_,
+  data_values = c(NA, sprintf("project_id = %d", 4:5)),
+  description = c(NA, rep("Delete project", 2)),
+  legacy = c(NA, rep(0, 2)),
+  change_reason = NA_character_
 )
 
 expected_result <- data.frame(
   project_id = 1:8,
   status = c(rep("deleted", 5), "previously deleted", rep("does not exist", 2))
 )
 
-# test function
+# Test function
 project_ids <- 1:8
 deleted_projects <- delete_project(project_ids, conn)
 
-testthat::test_that("delete_project deletes, updates and returns the correct project IDs", {
-  expect_equal(
-    DBI::dbGetQuery(conn, "select * from redcap_projects") |>
-      # convert date_deleted to yyyy-mm-dd to allow comparison with expected_redcap_projects
-      dplyr::mutate(date_deleted = as.Date(date_deleted)),
-    expected_redcap_projects
-  )
-
-  testthat::expect_equal(
-    DBI::dbGetQuery(conn, "select * from redcap_log_event1"),
-    expected_redcap_log_event1
-  )
-  testthat::expect_equal(
-    DBI::dbGetQuery(conn, "select * from redcap_log_event2"),
-    expected_redcap_log_event2
-  )
+testthat::test_that("delete_project deletes, updates, and returns the correct project IDs and logs", {
+  remove_seconds <- function(ts) {
+    if (is.na(ts)) {
+      return(NA)
+    }
+    substr(ts, 1, 12)
+  }
+
+  actual_redcap_log_event1 <- DBI::dbGetQuery(conn, "SELECT * FROM redcap_log_event1") |>
+    select(-log_event_id) |>
+    mutate(
+      ts = sapply(ts, remove_seconds)
+    )
+
+  expected_redcap_log_event1 <- expected_redcap_log_event1 |>
+    select(-log_event_id) |>
+    mutate(
+      ts = sapply(ts, remove_seconds)
+    )
+
+  testthat::expect_equal(actual_redcap_log_event1, expected_redcap_log_event1)
+
+  actual_redcap_log_event2 <- DBI::dbGetQuery(conn, "SELECT * FROM redcap_log_event2") |>
+    select(-log_event_id) |>
+    mutate(
+      ts = sapply(ts, remove_seconds)
+    )
+
+  expected_redcap_log_event2 <- expected_redcap_log_event2 |>
+    select(-log_event_id) |>
+    mutate(
+      ts = sapply(ts, remove_seconds)
+    )
+
+  testthat::expect_equal(actual_redcap_log_event2, expected_redcap_log_event2)
 
   testthat::expect_equal(deleted_projects$n, 5)
-
   testthat::expect_equal(deleted_projects$number_rows_logged, 5)
-
   testthat::expect_equal(deleted_projects$project_ids_deleted, 1:5)
-
   testthat::expect_equal(deleted_projects$data, expected_result)
-
 })
 
 DBI::dbDisconnect(conn, shutdown = TRUE)