From 3b64a1e32666704fb13360154b9a6b2c4d8643bd Mon Sep 17 00:00:00 2001 From: PietrH Date: Wed, 2 Oct 2024 10:58:05 +0200 Subject: [PATCH 01/18] save script for testing for postman api test mismatches --- .../find-postman-test-mismatch.R | 92 +++++++++++++++++++ 1 file changed, 92 insertions(+) create mode 100644 inst/postman-helpers/find-postman-test-mismatch.R diff --git a/inst/postman-helpers/find-postman-test-mismatch.R b/inst/postman-helpers/find-postman-test-mismatch.R new file mode 100644 index 0000000..021bea0 --- /dev/null +++ b/inst/postman-helpers/find-postman-test-mismatch.R @@ -0,0 +1,92 @@ +# check mismatch between js test and api response for list_acoustic_project_codes + + +# load libraries ---------------------------------------------------------- + +library(httr2) + + + +# set function to test ---------------------------------------------------- + +fn_to_test <- "list_station_names" + +# get reponse ------------------------------------------------------------- + + +## build request ---------------------------------------------------------- + +equest <- + request( + glue::glue( + "https://opencpu.lifewatch.be/library/etnservice/R/{fn_to_test}/json" + ) + ) + +response <- + request %>% + req_headers( + "Content-Type" = "application/json", + "Cookie" = "vliz_webc=vliz_webc2" + ) %>% + req_body_json(list( + credentials = list( + username = "pieter.huybrechts@inbo.be", + password = askpass::askpass("Please provide ETN db pwd") + ) + )) %>% + req_method("POST") %>% + req_perform() + +request <- request %>% + req_headers( + "Content-Type" = "application/json", + "Cookie" = "vliz_webc=vliz_webc2" + ) %>% + req_body_json(list( + credentials = list( + username = "pieter.huybrechts@inbo.be", + password = askpass::askpass("Please provide ETN db pwd") + ) + )) %>% + req_method("POST") + +# check against expectation ----------------------------------------------- + +# Make sure we didn't get a HTTP error +assertthat::assert_that(!httr2::resp_is_error(response)) + + +## extract current expectation -------------------------------------------- +expectation <- readr::read_lines( + glue::glue("tests/postman/test-{fn_to_test}.js") +) %>% + grep("pm.expect(jsonData).to.include.members(", + ., + fixed = TRUE, + value = TRUE) %>% + stringr::str_extract_all('(?<=")[^,]*?(?=\\")') %>% + unlist() + + +## extract response -------------------------------------------------------- + +api_response_values <- httr2::resp_body_json(response) %>% unlist() + +# report mismatch --------------------------------------------------------- + +# missing expected project codes: +api_response_values[ + !expectation %in% api_response_values] + +# Values from expectation that are not in the values the api responded +expectation[!expectation %in% api_response_values] + +# check if the response is always the same -------------------------------- +library(furrr) +plan("multisession", workers = 10) +furrr::future_map(rep(list(request), 100), ~resp_body_json(req_perform(.x))) %>% + purrr::map(digest::digest) %>% + unlist %>% + unique %>% + length(.) == 1 From 4fab76bc89cda92ce0f16bc1949960fa18443e25 Mon Sep 17 00:00:00 2001 From: PietrH Date: Wed, 2 Oct 2024 11:09:48 +0200 Subject: [PATCH 02/18] replace call to etn with call to self --- R/get_acoustic_detections.R | 2 +- R/get_acoustic_projects.R | 2 +- R/get_acoustic_receivers.R | 4 ++-- R/get_animal_projects.R | 2 +- R/get_animals.R | 2 +- R/get_cpod_projects.R | 2 +- R/get_tags.R | 2 +- R/list_acoustic_project_codes.R | 2 +- R/list_acoustic_tag_ids.R | 2 +- R/list_animal_project_codes.R | 2 +- R/list_cpod_project_codes.R | 2 +- 11 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/get_acoustic_detections.R b/R/get_acoustic_detections.R index f35f96d..8b85442 100644 --- a/R/get_acoustic_detections.R +++ b/R/get_acoustic_detections.R @@ -215,7 +215,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 ) diff --git a/R/get_acoustic_projects.R b/R/get_acoustic_projects.R index 082f27e..2354708 100644 --- a/R/get_acoustic_projects.R +++ b/R/get_acoustic_projects.R @@ -53,7 +53,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 ) diff --git a/R/get_acoustic_receivers.R b/R/get_acoustic_receivers.R index d6570ab..dfdca3d 100644 --- a/R/get_acoustic_receivers.R +++ b/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 ) diff --git a/R/get_animal_projects.R b/R/get_animal_projects.R index c552644..17c0c60 100644 --- a/R/get_animal_projects.R +++ b/R/get_animal_projects.R @@ -52,7 +52,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 ) diff --git a/R/get_animals.R b/R/get_animals.R index 4317be2..ec2518b 100644 --- a/R/get_animals.R +++ b/R/get_animals.R @@ -121,7 +121,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 ) diff --git a/R/get_cpod_projects.R b/R/get_cpod_projects.R index 459b17c..5bb6cd4 100644 --- a/R/get_cpod_projects.R +++ b/R/get_cpod_projects.R @@ -52,7 +52,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 ) diff --git a/R/get_tags.R b/R/get_tags.R index a370801..5d8466d 100644 --- a/R/get_tags.R +++ b/R/get_tags.R @@ -116,7 +116,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 ) diff --git a/R/list_acoustic_project_codes.R b/R/list_acoustic_project_codes.R index 0289c76..cc6d181 100644 --- a/R/list_acoustic_project_codes.R +++ b/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( diff --git a/R/list_acoustic_tag_ids.R b/R/list_acoustic_tag_ids.R index a98e4f0..ab4d4bd 100644 --- a/R/list_acoustic_tag_ids.R +++ b/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(" diff --git a/R/list_animal_project_codes.R b/R/list_animal_project_codes.R index ce58c15..e8328ad 100644 --- a/R/list_animal_project_codes.R +++ b/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( diff --git a/R/list_cpod_project_codes.R b/R/list_cpod_project_codes.R index b7085e0..7d20681 100644 --- a/R/list_cpod_project_codes.R +++ b/R/list_cpod_project_codes.R @@ -18,7 +18,7 @@ list_cpod_project_codes <- function(credentials = list( 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( From bff56587449b22fcdd5a5c4b231e52f2d211fcdb Mon Sep 17 00:00:00 2001 From: PietrH Date: Wed, 2 Oct 2024 14:50:26 +0200 Subject: [PATCH 03/18] add helper to check if credentials are of right form --- R/utils.R | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/R/utils.R b/R/utils.R index 5e723f6..7ecd887 100644 --- a/R/utils.R +++ b/R/utils.R @@ -110,6 +110,44 @@ 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 +#' credentials <- list(username = "john_doe", password = "password123") +#' check_credentials(credentials) +#' #> [1] TRUE +check_credentials <- function(credentials) { + + assertthat::assert_that( + assertthat::has_name(credentials, "username") + ) + + assertthat::assert_that( + assertthat::has_name(credentials, "password") + ) + + assertthat::assert_that( + length(credentials) == 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 From 264eb3edaf9c6f2f4ce8147b1a9ec1bad28f5dcb Mon Sep 17 00:00:00 2001 From: PietrH Date: Wed, 2 Oct 2024 14:51:37 +0200 Subject: [PATCH 04/18] Improve error messaging --- R/utils.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/utils.R b/R/utils.R index 7ecd887..426206a 100644 --- a/R/utils.R +++ b/R/utils.R @@ -126,15 +126,18 @@ get_credentials <- check_credentials <- function(credentials) { assertthat::assert_that( - assertthat::has_name(credentials, "username") + assertthat::has_name(credentials, "username"), + msg = "The credentials need to contain a 'username' field." ) assertthat::assert_that( - assertthat::has_name(credentials, "password") + assertthat::has_name(credentials, "password"), + msg = "The credentials need to contain a 'password' field." ) assertthat::assert_that( - length(credentials) == 2 + length(credentials) == 2, + msg = "The credentials object should have a length of 2." ) assertthat::assert_that( From a1ff9276ebc7c08f711bceb520a2d236fb049263 Mon Sep 17 00:00:00 2001 From: PietrH Date: Fri, 4 Oct 2024 10:50:10 +0200 Subject: [PATCH 05/18] Check if the credentials at least have the right shape --- R/get_tags.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/get_tags.R b/R/get_tags.R index 5d8466d..53e5193 100644 --- a/R/get_tags.R +++ b/R/get_tags.R @@ -49,6 +49,9 @@ get_tags <- function(credentials = list( tag_serial_number = NULL, acoustic_tag_id = NULL) { + # Check credentials + check_credentials(credentials) + # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) From 30301e249721f53f9f5237f5035345e2c594b46a Mon Sep 17 00:00:00 2001 From: PietrH Date: Fri, 4 Oct 2024 10:50:32 +0200 Subject: [PATCH 06/18] Provide a more informative error message when creating the database connection fails --- R/connect_to_etn.R | 29 +++++++++++++++++++++++------ tests/testthat/test-get_tags.R | 3 ++- 2 files changed, 25 insertions(+), 7 deletions(-) diff --git a/R/connect_to_etn.R b/R/connect_to_etn.R index f3a955f..3cdfe91 100644 --- a/R/connect_to_etn.R +++ b/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) } diff --git a/tests/testthat/test-get_tags.R b/tests/testthat/test-get_tags.R index 19aeb22..ec24298 100644 --- a/tests/testthat/test-get_tags.R +++ b/tests/testthat/test-get_tags.R @@ -5,7 +5,8 @@ credentials <- list( test_that("get_tags() returns error for incorrect connection", { expect_error( - get_tags(credentials = "not_a_connection"), + get_tags(credentials = list(username = "not a username", + password = "not a password")), "Not a connection object to database." ) }) From c9eaf12531e8fbcafee9c9c46f7fcd42f2bc4bf5 Mon Sep 17 00:00:00 2001 From: PietrH Date: Fri, 4 Oct 2024 11:11:52 +0200 Subject: [PATCH 07/18] use skip() instead of comments to disable tests: more explicit, harder to miss --- tests/testthat/test-get_acoustic_detections.R | 30 ++++++++++--------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/tests/testthat/test-get_acoustic_detections.R b/tests/testthat/test-get_acoustic_detections.R index ab1b37a..01d53e2 100644 --- a/tests/testthat/test-get_acoustic_detections.R +++ b/tests/testthat/test-get_acoustic_detections.R @@ -281,19 +281,20 @@ test_that("get_acoustic_detections() returns acoustic and acoustic-archival tags }) # TODO: re-enable after https://github.com/inbo/etn/issues/252 -# test_that("get_acoustic_detections() returns detections from acoustic_tag_id_alternative", { -# # The following acoustic_tag_ids only occur as acoustic_tag_id_alternative -# -# # A69-1105-26 (tag_serial_number = 1734026) is associated with animal -# # - 5902 (2017_Fremur) from 2017-12-01 00:00 to open -# # Almost all its detections are from after the release date -# expect_gt(nrow(get_acoustic_detections(credentials, acoustic_tag_id = "A69-1105-26")), 0) -# -# # A69-1105-155 (tag_serial_number = 1712155) is associated with animal -# # - 4140 (OTN-Skjerstadfjorden) from 2017-05-31 01:00 to open -# # All detections are from before the release date, so it should return 0 -# expect_equal(nrow(get_acoustic_detections(credentials, acoustic_tag_id = "A69-1105-155")), 0) -# }) +test_that("get_acoustic_detections() returns detections from acoustic_tag_id_alternative", { + skip("TODO: re-enable after https://github.com/inbo/etn/issues/252") + # The following acoustic_tag_ids only occur as acoustic_tag_id_alternative + + # A69-1105-26 (tag_serial_number = 1734026) is associated with animal + # - 5902 (2017_Fremur) from 2017-12-01 00:00 to open + # Almost all its detections are from after the release date + expect_gt(nrow(get_acoustic_detections(credentials, acoustic_tag_id = "A69-1105-26")), 0) + + # A69-1105-155 (tag_serial_number = 1712155) is associated with animal + # - 4140 (OTN-Skjerstadfjorden) from 2017-05-31 01:00 to open + # All detections are from before the release date, so it should return 0 + expect_equal(nrow(get_acoustic_detections(credentials, acoustic_tag_id = "A69-1105-155")), 0) +}) test_that("get_acoustic_detections() does not return duplicate detections across acoustic_id and acoustic_id_alternative", { # A69-1105-100 is used as acoustic_tag_id once and acoustic_tag_id_alternative twice: @@ -304,7 +305,8 @@ test_that("get_acoustic_detections() does not return duplicate detections across # Expect no duplicates df <- get_acoustic_detections(credentials, acoustic_tag_id = "A69-1105-100") - # expect_equal(nrow(df), nrow(df %>% distinct(detection_id))) # TODO: https://github.com/inbo/etn/issues/216 + skip("TODO: https://github.com/inbo/etn/issues/216") + expect_equal(nrow(df), nrow(df %>% distinct(detection_id))) # TODO: https://github.com/inbo/etn/issues/216 }) test_that("get_acoustic_detections() does not return duplicate detections when tags are reused", { From f2fb3e53aac1de9813d6196d761315ab61c2c0ec Mon Sep 17 00:00:00 2001 From: PietrH Date: Fri, 4 Oct 2024 11:12:23 +0200 Subject: [PATCH 08/18] Check if the credentials have the right shape before trying to connect to the database --- R/get_acoustic_deployments.R | 3 +++ R/get_acoustic_projects.R | 4 ++++ R/get_animal_projects.R | 4 ++++ R/get_animals.R | 4 ++++ R/list_cpod_project_codes.R | 3 +++ 5 files changed, 18 insertions(+) diff --git a/R/get_acoustic_deployments.R b/R/get_acoustic_deployments.R index 6e07dea..cd9e049 100644 --- a/R/get_acoustic_deployments.R +++ b/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) diff --git a/R/get_acoustic_projects.R b/R/get_acoustic_projects.R index 2354708..8bb5e92 100644 --- a/R/get_acoustic_projects.R +++ b/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) diff --git a/R/get_animal_projects.R b/R/get_animal_projects.R index 17c0c60..96571b2 100644 --- a/R/get_animal_projects.R +++ b/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) diff --git a/R/get_animals.R b/R/get_animals.R index ec2518b..18ee4e3 100644 --- a/R/get_animals.R +++ b/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) diff --git a/R/list_cpod_project_codes.R b/R/list_cpod_project_codes.R index 7d20681..445267c 100644 --- a/R/list_cpod_project_codes.R +++ b/R/list_cpod_project_codes.R @@ -11,6 +11,9 @@ 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) From db5ca3e4e43e5e4948b2a02cd7eb15c24bc25fe2 Mon Sep 17 00:00:00 2001 From: PietrH Date: Fri, 4 Oct 2024 11:38:48 +0200 Subject: [PATCH 09/18] Check the shape of the credentials, not their validity --- R/get_tags.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/get_tags.R b/R/get_tags.R index 53e5193..23886e4 100644 --- a/R/get_tags.R +++ b/R/get_tags.R @@ -49,7 +49,7 @@ get_tags <- function(credentials = list( tag_serial_number = NULL, acoustic_tag_id = NULL) { - # Check credentials + # Check if credentials object has right shape check_credentials(credentials) # Create connection object From c50f85cd286b09c0e6a726edbcd2923c471b9595 Mon Sep 17 00:00:00 2001 From: PietrH Date: Fri, 4 Oct 2024 11:39:07 +0200 Subject: [PATCH 10/18] Check if the credentials are provided in the right shape --- R/get_acoustic_detections.R | 2 ++ R/get_cpod_projects.R | 4 ++++ 2 files changed, 6 insertions(+) diff --git a/R/get_acoustic_detections.R b/R/get_acoustic_detections.R index 8b85442..4d978f6 100644 --- a/R/get_acoustic_detections.R +++ b/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) diff --git a/R/get_cpod_projects.R b/R/get_cpod_projects.R index 5bb6cd4..ef31e30 100644 --- a/R/get_cpod_projects.R +++ b/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) From 7233da0ca779ad5b19af6fa8fb80722941fe7f2a Mon Sep 17 00:00:00 2001 From: PietrH Date: Fri, 4 Oct 2024 11:39:35 +0200 Subject: [PATCH 11/18] Test error messages for failing to connect to the database --- .../testthat/test-get_acoustic_deployments.R | 8 +++++++- tests/testthat/test-get_acoustic_detections.R | 19 +++++++++++++++++-- tests/testthat/test-get_acoustic_projects.R | 7 ++++++- tests/testthat/test-get_acoustic_receivers.R | 7 ++++++- tests/testthat/test-get_animal_projects.R | 7 ++++++- tests/testthat/test-get_animals.R | 7 ++++++- tests/testthat/test-get_cpod_projects.R | 7 ++++++- tests/testthat/test-get_tags.R | 2 +- 8 files changed, 55 insertions(+), 9 deletions(-) diff --git a/tests/testthat/test-get_acoustic_deployments.R b/tests/testthat/test-get_acoustic_deployments.R index 81a7552..f181c10 100644 --- a/tests/testthat/test-get_acoustic_deployments.R +++ b/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." ) }) diff --git a/tests/testthat/test-get_acoustic_detections.R b/tests/testthat/test-get_acoustic_detections.R index 01d53e2..198f3fb 100644 --- a/tests/testthat/test-get_acoustic_detections.R +++ b/tests/testthat/test-get_acoustic_detections.R @@ -6,11 +6,26 @@ credentials <- list( test_that("get_acoustic_detections() returns error for incorrect connection", { expect_error( get_acoustic_detections(credentials = "not_a_connection"), - "Not a connection object to database." + "The credentials need to contain a 'username' field." + ) + expect_error( + get_acoustic_detections(credentials = list(username = "username")), + "The credentials need to contain a 'password' field." + ) + expect_error( + get_acoustic_detections(credentials = list(unexpected_field = 4, + username = "username", + password = "not a password")), + "The credentials object should have a length of 2." + ) + expect_error( + get_acoustic_detections(credentials = list(username = "not a username", + password = "the wrong pwd")), + "Failed to connect to the database." ) }) -test_that("get_acoustic_detections() returns a tibble", { + test_that("get_acoustic_detections() returns a tibble", { df <- get_acoustic_detections(credentials, limit = TRUE) expect_s3_class(df, "data.frame") expect_s3_class(df, "tbl") diff --git a/tests/testthat/test-get_acoustic_projects.R b/tests/testthat/test-get_acoustic_projects.R index b850c58..32a34e9 100644 --- a/tests/testthat/test-get_acoustic_projects.R +++ b/tests/testthat/test-get_acoustic_projects.R @@ -6,7 +6,12 @@ credentials <- list( test_that("get_acoustic_projects() returns error for incorrect connection", { expect_error( get_acoustic_projects(credentials = "not_a_credentials"), - "Not a connection object to database." + "The credentials need to contain a 'username' field." + ) + expect_error( + get_acoustic_projects(credentials = list(username = "not a username", + password = "the wrong pwd")), + "Failed to connect to the database." ) }) diff --git a/tests/testthat/test-get_acoustic_receivers.R b/tests/testthat/test-get_acoustic_receivers.R index 5c13f8b..847698b 100644 --- a/tests/testthat/test-get_acoustic_receivers.R +++ b/tests/testthat/test-get_acoustic_receivers.R @@ -6,7 +6,12 @@ credentials <- list( test_that("get_acoustic_receivers() returns error for incorrect credentials", { expect_error( get_acoustic_receivers(credentials = "not_a_credentials"), - "Not a connection object to database." + "Failed to connect to the database." + ) + expect_error( + get_acoustic_receivers(credentials = list(username = "not a username", + password = "the wrong pwd")), + "Failed to connect to the database." ) }) diff --git a/tests/testthat/test-get_animal_projects.R b/tests/testthat/test-get_animal_projects.R index 71f0dbf..2cffc64 100644 --- a/tests/testthat/test-get_animal_projects.R +++ b/tests/testthat/test-get_animal_projects.R @@ -6,7 +6,12 @@ credentials <- list( test_that("get_animal_projects() returns error for incorrect connection", { expect_error( get_animal_projects(credentials = "not_a_connection"), - "Not a connection object to database." + "The credentials need to contain a 'username' field." + ) + expect_error( + get_animal_projects(credentials = list(username = "not a username", + password = "the wrong pwd")), + "Failed to connect to the database." ) }) diff --git a/tests/testthat/test-get_animals.R b/tests/testthat/test-get_animals.R index 6ddab45..bc000e7 100644 --- a/tests/testthat/test-get_animals.R +++ b/tests/testthat/test-get_animals.R @@ -6,7 +6,12 @@ credentials <- list( test_that("get_animals() returns error for incorrect connection", { expect_error( get_animals(credentials = "not_a_connection"), - "Not a connection object to database." + "The credentials need to contain a 'username' field." + ) + expect_error( + get_animals(credentials = list(username = "not a username", + password = "the wrong pwd")), + "Failed to connect to the database." ) }) diff --git a/tests/testthat/test-get_cpod_projects.R b/tests/testthat/test-get_cpod_projects.R index 09f835f..a9e2d0b 100644 --- a/tests/testthat/test-get_cpod_projects.R +++ b/tests/testthat/test-get_cpod_projects.R @@ -6,7 +6,12 @@ credentials <- list( test_that("get_cpod_projects() returns error for incorrect connection", { expect_error( get_cpod_projects(credentials = "not_a_connection"), - "Not a connection object to database." + "The credentials need to contain a 'username' field." + ) + expect_error( + get_cpod_projects(credentials = list(username = "not a username", + password = "the wrong pwd")), + "Failed to connect to the database." ) }) diff --git a/tests/testthat/test-get_tags.R b/tests/testthat/test-get_tags.R index ec24298..1a1bced 100644 --- a/tests/testthat/test-get_tags.R +++ b/tests/testthat/test-get_tags.R @@ -7,7 +7,7 @@ test_that("get_tags() returns error for incorrect connection", { expect_error( get_tags(credentials = list(username = "not a username", password = "not a password")), - "Not a connection object to database." + "Failed to connect to the database." ) }) From 8fc16d36bdf6740d7956d64afb9c9fa38f162629 Mon Sep 17 00:00:00 2001 From: PietrH Date: Tue, 22 Oct 2024 12:02:38 +0200 Subject: [PATCH 12/18] devtools::document() --- DESCRIPTION | 2 +- R/utils.R | 2 ++ man/check_credentials.Rd | 25 +++++++++++++++++++++++++ 3 files changed, 28 insertions(+), 1 deletion(-) create mode 100644 man/check_credentials.Rd diff --git a/DESCRIPTION b/DESCRIPTION index b26c7ab..9bc39e2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,7 +15,7 @@ Description: Provides API endpoints to the European Tracking Network. Designed License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.2 Imports: assertthat, DBI, diff --git a/R/utils.R b/R/utils.R index 426206a..62e5ab3 100644 --- a/R/utils.R +++ b/R/utils.R @@ -120,9 +120,11 @@ get_credentials <- #' @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( diff --git a/man/check_credentials.Rd b/man/check_credentials.Rd new file mode 100644 index 0000000..72838d0 --- /dev/null +++ b/man/check_credentials.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{check_credentials} +\alias{check_credentials} +\title{Check if the provided credentials are valid.} +\usage{ +check_credentials(credentials) +} +\arguments{ +\item{credentials}{A list or data frame containing the credentials to be checked.} +} +\value{ +TRUE if the credentials are valid, an error otherwise +} +\description{ +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. +} +\examples{ +\dontrun{ +credentials <- list(username = "john_doe", password = "password123") +check_credentials(credentials) +#> [1] TRUE +} +} From bea8a24e48317f5f145898d628f1919c9c62f3b7 Mon Sep 17 00:00:00 2001 From: PietrH Date: Tue, 22 Oct 2024 12:08:39 +0200 Subject: [PATCH 13/18] usethis::use_tidy_description() --- DESCRIPTION | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9bc39e2..bebb54d 100644 --- a/DESCRIPTION +++ b/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.3.2 Imports: assertthat, DBI, @@ -28,3 +26,6 @@ Imports: odbc, readr, stringr +Encoding: UTF-8 +Roxygen: list(markdown = TRUE) +RoxygenNote: 7.3.2 From eb5496184a2f8c60d7bdbae4a8f88e746739ffa3 Mon Sep 17 00:00:00 2001 From: PietrH Date: Tue, 22 Oct 2024 12:08:54 +0200 Subject: [PATCH 14/18] remove incorrect dubble assignment --- R/list_scientific_names.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/list_scientific_names.R b/R/list_scientific_names.R index 37e815d..0780fd8 100644 --- a/R/list_scientific_names.R +++ b/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 From 2b6ef69518bebf71adac0e8f8d9ad3f811d6e2ad Mon Sep 17 00:00:00 2001 From: PietrH Date: Tue, 22 Oct 2024 14:16:46 +0200 Subject: [PATCH 15/18] Add tests for error message --- tests/testthat/test-connect_to_etn.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/testthat/test-connect_to_etn.R b/tests/testthat/test-connect_to_etn.R index c31fbb9..3bb4558 100644 --- a/tests/testthat/test-connect_to_etn.R +++ b/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.") +}) From db456066a81d4454321398ecf3194c9ac5f176ef Mon Sep 17 00:00:00 2001 From: PietrH Date: Tue, 22 Oct 2024 14:49:13 +0200 Subject: [PATCH 16/18] usethis::use_testthat() --- DESCRIPTION | 3 +++ tests/testthat.R | 12 ++++++++++++ 2 files changed, 15 insertions(+) create mode 100644 tests/testthat.R diff --git a/DESCRIPTION b/DESCRIPTION index bebb54d..07291f8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,3 +29,6 @@ Imports: Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 +Suggests: + testthat (>= 3.0.0) +Config/testthat/edition: 3 diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..622aa33 --- /dev/null +++ b/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") From 75c4d83b1ebfffde4a6b247ab7d381f31b32df33 Mon Sep 17 00:00:00 2001 From: PietrH Date: Tue, 22 Oct 2024 15:09:06 +0200 Subject: [PATCH 17/18] split up expectations into tests, add skip for known issue --- tests/testthat/test-list_receiver_ids.R | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-list_receiver_ids.R b/tests/testthat/test-list_receiver_ids.R index a657d73..2f93201 100644 --- a/tests/testthat/test-list_receiver_ids.R +++ b/tests/testthat/test-list_receiver_ids.R @@ -3,12 +3,21 @@ credentials <- list( password = Sys.getenv("pwd") ) +vector <- list_receiver_ids(credentials) + test_that("list_receiver_ids() returns unique list of values", { - vector <- list_receiver_ids(credentials) + expect_false(any(duplicated(vector))) +}) +test_that("list_receiver_ids() returns a character vector", { expect_is(vector, "character") - expect_false(any(duplicated(vector))) +}) + +test_that("list_receiver_ids() does not return NA values", { + skip("Empty receiver value in acoustic.receivers, ISSUE https://github.com/inbo/etn/issues/333") expect_true(all(!is.na(vector))) +}) +test_that("list_receiver_ids() returns known value", { expect_true("VR2W-124070" %in% vector) }) From 61d66b83d9d9e1fa9d27fbcebf7bc68d7073d5aa Mon Sep 17 00:00:00 2001 From: PietrH Date: Tue, 22 Oct 2024 15:09:21 +0200 Subject: [PATCH 18/18] add skip for known issue --- tests/testthat/test-get_acoustic_detections.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-get_acoustic_detections.R b/tests/testthat/test-get_acoustic_detections.R index 198f3fb..450fd64 100644 --- a/tests/testthat/test-get_acoustic_detections.R +++ b/tests/testthat/test-get_acoustic_detections.R @@ -32,6 +32,7 @@ test_that("get_acoustic_detections() returns error for incorrect connection", { }) test_that("get_acoustic_detections() returns unique detection_id", { + skip("duplicate detection ids: https://github.com/inbo/etn/issues/283") df <- get_acoustic_detections(credentials, limit = TRUE) expect_equal(nrow(df), nrow(df %>% distinct(detection_id))) })