Use included SQL files instead of those included in etn

DESCRIPTION

@@ -9,13 +9,11 @@ Authors@R: c(
     person("Research Institute for Nature and Forest (INBO)", role = "cph",
            comment = "https://www.vlaanderen.be/inbo/en-gb/"),
     person("LifeWatch Belgium", role = "fnd",
-           comment = "https://lifewatch.be"))
-Description: Provides API endpoints to the European Tracking Network. Designed 
-    to be used with OpenCPU and the 'etn' package.
+           comment = "https://lifewatch.be")
+  )
+Description: Provides API endpoints to the European Tracking Network.
+    Designed to be used with OpenCPU and the 'etn' package.
 License: MIT + file LICENSE
-Encoding: UTF-8
-Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
 Imports: 
     assertthat,
     DBI,
@@ -28,3 +26,9 @@ Imports:
     odbc,
     readr,
     stringr
+Encoding: UTF-8
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.3.2
+Suggests: 
+    testthat (>= 3.0.0)
+Config/testthat/edition: 3

R/connect_to_etn.R

@@ -19,11 +19,28 @@
 #' con <- connect_to_etn(username = "my_username", password = "my_password")
 #' }
 connect_to_etn <- function(username, password) {
-  connection <- DBI::dbConnect(
-    odbc::odbc(),
-    "ETN",
-    uid = paste("", tolower(username), "", sep = ""),
-    pwd = paste("", password, "", sep = "")
+  tryCatch(
+    {
+      # Attempt to connect to the database with the provided credentials
+      connection <- DBI::dbConnect(
+        odbc::odbc(),
+        "ETN",
+        uid = paste("", tolower(username), "", sep = ""),
+        pwd = paste("", password, "", sep = "")
+      )
+      return(connection)
+    },
+    error = function(e) {
+        # When the database connection fails, return the error message and some
+        # directions to try again. This is usually due to a wrong password, so
+        # let's include that as a clue in the error message.
+        stop(glue::glue(e$message,
+                        "Failed to connect to the database.",
+                        "Did you enter the right username/password?",
+                        "Please try again.",
+                        .sep = "\n"),
+        call. = FALSE)
+
+    }
   )
-  return(connection)
 }

R/get_acoustic_deployments.R

@@ -52,6 +52,9 @@ get_acoustic_deployments <- function(
     station_name = NULL,
     open_only = FALSE) {
 
+  # Check if credentials object has right shape
+  check_credentials(credentials)
+
   # create connection object
   connection <-
     connect_to_etn(credentials$username, credentials$password)

R/get_acoustic_detections.R

@@ -90,6 +90,8 @@ get_acoustic_detections <- function(credentials = list(
                                     station_name = NULL,
                                     limit = FALSE) {
 
+  # Check if credentials object has right shape
+  check_credentials(credentials)
 
   # Create connection object
   connection <- connect_to_etn(credentials$username, credentials$password)
@@ -215,7 +217,7 @@ get_acoustic_detections <- function(credentials = list(
   }
 
   acoustic_tag_id_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etn")),
+    readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etnservice")),
     .con = connection
   )
 

R/get_acoustic_projects.R

@@ -29,6 +29,10 @@ get_acoustic_projects <- function(credentials = list(
                                     password = Sys.getenv("pwd")
                                   ),
                                   acoustic_project_code = NULL) {
+
+  # Check if credentials object has right shape
+  check_credentials(credentials)
+
   # create connection object
   connection <-
     connect_to_etn(credentials$username, credentials$password)
@@ -53,7 +57,7 @@ get_acoustic_projects <- function(credentials = list(
   }
 
   project_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "project.sql", package = "etn")),
+    readr::read_file(system.file("sql", "project.sql", package = "etnservice")),
     .con = connection
   )
 

R/get_acoustic_receivers.R

@@ -66,11 +66,11 @@ get_acoustic_receivers <- function(credentials = list(
   }
 
   receiver_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "receiver.sql", package = "etn")),
+    readr::read_file(system.file("sql", "receiver.sql", package = "etnservice")),
     .con = connection
   )
   acoustic_tag_id_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etn")),
+    readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etnservice")),
     .con = connection
   )
 

R/get_animal_projects.R

@@ -29,6 +29,10 @@ get_animal_projects <- function(credentials = list(
                                   password = Sys.getenv("pwd")
                                 ),
                                 animal_project_code = NULL) {
+
+  # Check if credentials object has right shape
+  check_credentials(credentials)
+
   # Create connection object
   connection <- connect_to_etn(credentials$username, credentials$password)
 
@@ -52,7 +56,7 @@ get_animal_projects <- function(credentials = list(
   }
 
   project_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "project.sql", package = "etn")),
+    readr::read_file(system.file("sql", "project.sql", package = "etnservice")),
     .con = connection
   )
 

R/get_animals.R

@@ -52,6 +52,10 @@ get_animals <- function(credentials = list(
                         tag_serial_number = NULL,
                         animal_project_code = NULL,
                         scientific_name = NULL) {
+
+  # Check if credentials object has right shape
+  check_credentials(credentials)
+
   # Create connection object
   connection <- connect_to_etn(credentials$username, credentials$password)
 
@@ -121,7 +125,7 @@ get_animals <- function(credentials = list(
   }
 
   tag_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "tag.sql", package = "etn")),
+    readr::read_file(system.file("sql", "tag.sql", package = "etnservice")),
     .con = connection
   )
 

R/get_cpod_projects.R

@@ -29,6 +29,10 @@ get_cpod_projects <- function(credentials = list(
                                 password = Sys.getenv("pwd")
                               ),
                               cpod_project_code = NULL) {
+
+  # Check if credentials object has right shape
+  check_credentials(credentials)
+
   # Create connection object
   connection <- connect_to_etn(credentials$username, credentials$password)
 
@@ -52,7 +56,7 @@ get_cpod_projects <- function(credentials = list(
   }
 
   project_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "project.sql", package = "etn")),
+    readr::read_file(system.file("sql", "project.sql", package = "etnservice")),
     .con = connection
   )
 

R/get_tags.R

@@ -49,6 +49,9 @@ get_tags <- function(credentials = list(
                      tag_serial_number = NULL,
                      acoustic_tag_id = NULL) {
 
+  # Check if credentials object has right shape
+  check_credentials(credentials)
+
   # Create connection object
   connection <- connect_to_etn(credentials$username, credentials$password)
 
@@ -116,7 +119,7 @@ get_tags <- function(credentials = list(
   }
 
   tag_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "tag.sql", package = "etn")),
+    readr::read_file(system.file("sql", "tag.sql", package = "etnservice")),
     .con = connection
   )
 

R/list_acoustic_project_codes.R

@@ -13,7 +13,7 @@ list_acoustic_project_codes <- function(credentials = list(
   connection <- connect_to_etn(credentials$username, credentials$password)
 
   project_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "project.sql", package = "etn")),
+    readr::read_file(system.file("sql", "project.sql", package = "etnservice")),
     .con = connection
   )
   query <- glue::glue_sql(

R/list_acoustic_tag_ids.R

@@ -11,7 +11,7 @@ list_acoustic_tag_ids <- function(credentials = list(
 )) {
   connection <- connect_to_etn(credentials$username, credentials$password)
   acoustic_tag_id_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etn")),
+    readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etnservice")),
     .con = connection
   )
   query <- glue::glue_sql("

R/list_animal_project_codes.R

@@ -13,7 +13,7 @@ list_animal_project_codes <- function(credentials = list(
   connection <- connect_to_etn(credentials$username, credentials$password)
 
   project_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "project.sql", package = "etn")),
+    readr::read_file(system.file("sql", "project.sql", package = "etnservice")),
     .con = connection
   )
   query <- glue::glue_sql(

R/list_cpod_project_codes.R

@@ -11,14 +11,17 @@ list_cpod_project_codes <- function(credentials = list(
   password = Sys.getenv("pwd")
 )) {
 
+  # Check if credentials object has right shape
+  check_credentials(credentials)
+
   # Create connection object
   connection <- connect_to_etn(credentials$username, credentials$password)
 
   # Check if we can make a connection
   check_connection(connection)
 
   project_query <- glue::glue_sql(
-    readr::read_file(system.file("sql", "project.sql", package = "etn")),
+    readr::read_file(system.file("sql", "project.sql", package = "etnservice")),
     .con = connection
   )
   query <- glue::glue_sql(

R/list_scientific_names.R

@@ -10,7 +10,7 @@ list_scientific_names <- function(credentials = list(
                                     username = Sys.getenv("userid"),
                                     password = Sys.getenv("pwd")
                                   )) {
-  connection <- connection <- connect_to_etn(credentials$username, credentials$password)
+  connection <- connect_to_etn(credentials$username, credentials$password)
   query <- glue::glue_sql(
     "SELECT DISTINCT scientific_name FROM common.animal_release",
     .con = connection

R/utils.R

@@ -110,6 +110,49 @@ get_credentials <-
     stringr::str_glue('list(username = "{username}", password = "{password}")')
   }
 
+#' Check if the provided credentials are valid.
+#'
+#' This function checks if the provided credentials contain a "username" and "password" field,
+#' and if both fields are of type character. It also verifies that the credentials object has a length of 2.
+#'
+#' @param credentials A list or data frame containing the credentials to be checked.
+#'
+#' @return TRUE if the credentials are valid, an error otherwise
+#'
+#' @examples
+#' \dontrun{
+#' credentials <- list(username = "john_doe", password = "password123")
+#' check_credentials(credentials)
+#' #> [1] TRUE
+#' }
+check_credentials <- function(credentials) {
+
+  assertthat::assert_that(
+    assertthat::has_name(credentials, "username"),
+    msg = "The credentials need to contain a 'username' field."
+  )
+
+  assertthat::assert_that(
+    assertthat::has_name(credentials, "password"),
+    msg = "The credentials need to contain a 'password' field."
+  )
+
+  assertthat::assert_that(
+    length(credentials) == 2,
+    msg = "The credentials object should have a length of 2."
+  )
+
+  assertthat::assert_that(
+    assertthat::is.string(credentials$username)
+  )
+
+  assertthat::assert_that(
+    assertthat::is.string(credentials$password)
+  )
+
+  return(TRUE)
+}
+
 #' Extract the OCPU temp key from a response object
 #'
 #' When posting a request to the opencpu api service without the json flag, a

inst/postman-helpers/find-postman-test-mismatch.R

@@ -11,6 +11,7 @@ library(httr2)
 
 fn_to_test <- "list_acoustic_tag_ids"
 
+
 # get reponse -------------------------------------------------------------
 
 

tests/testthat.R

@@ -0,0 +1,12 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/tests.html
+# * https://testthat.r-lib.org/reference/test_package.html#special-files
+
+library(testthat)
+library(etnservice)
+
+test_check("etnservice")

tests/testthat/test-connect_to_etn.R

@@ -8,3 +8,14 @@ test_that("connect_to_etn() allows to create a connection with passed credential
   expect_true(isClass(connection, "PostgreSQL"))
   DBI::dbDisconnect(connection)
 })
+
+test_that("connect_to_etn() returns a clear error when connecting to db fails",{
+  expect_error(connect_to_etn("only one argument"),
+               regexp = "Failed to connect to the database.")
+  expect_error(connect_to_etn(password = "missing username"),
+               regexp = "Failed to connect to the database.")
+  expect_error(connect_to_etn(username = "missing password"),
+               regexp = "Failed to connect to the database.")
+  expect_error(connect_to_etn(username = "", password = ""),
+               regexp = "Failed to connect to the database.")
+})

tests/testthat/test-get_acoustic_deployments.R

@@ -6,7 +6,13 @@ credentials <- list(
 test_that("get_acoustic_deployments() returns error for incorrect connection", {
   expect_error(
     get_acoustic_deployments(credentials = "not_a_credentials"),
-    "Not a credentials object to database."
+    "The credentials need to contain a 'username' field",
+    fixed = TRUE
+  )
+  expect_error(
+    get_acoustic_deployments(credentials = list(username = "not a username",
+                                                password = "the wrong password")),
+    "Failed to connect to the database."
   )
 })