Merge branch 'main' into keyring_417

NEWS

@@ -20,6 +20,8 @@ A future release of version 3.0.0 will introduce several breaking changes!
 * `unlockREDCap` no longer changes console focus
 * Vectorized `renameRecord` and `exportFieldNames`
 * Exporting `connectAndCheck` function to establish connections
+* Improved error messages when misspecified URL is provided.
+* Fix for redirected URLs
 
 ## 2.10.0
 

R/unlockREDCap.R

@@ -50,7 +50,10 @@ connectAndCheck <- function(key, url, ...)
       if(!response$status_code %in% c(301L, 302L)) return(rcon)
 
       # Handle redirect
-      rcon <- redcapConnection(token=key, url=response$header$location, ...)
+      rcon <- redcapConnection(
+        token = key,
+        url   = paste0(response$header$location, '/api/'),
+        ...)
 
       # Test connection by checking version post redirect
       response <- makeApiCall(rcon, body = version,
@@ -59,13 +62,17 @@ connectAndCheck <- function(key, url, ...)
       if(response$status_code %in% c(301L, 302L))
         stop(paste("Too many redirects from", url))
 
+
       rcon
     },
     error = function(e)
     {
-      if(grepl("Could not resolve host",     e) ||
+      if(grepl("Could not resolve host",     e)  ||
          grepl("Could not connect to server", e))
-        stop("Unable to connect to url '",url,"'. ", e$message)
+        stop("Invalid URL provided '",url,"'. Unable to resolve or route.\n", e$message)
+
+      if(grepl("405", e$message) )
+        stop("URL '",url,"' refused connection. Not acting like a REDCap server.\n", e$message)
 
       if(grepl("403", e)) return(NULL) # Forbidden, i.e. bad API_KEY
 

tests/testthat/test-024-unlockREDCap.R

@@ -5,12 +5,12 @@ library(curl)
 
 h <- new_handle(timeout = 1L)
 redirect <- structure(
-  list(url = "https://test.xyz/api",
+  list(url = "https://test.xyz/api/",
        status_code = 302L,
        content = "",
        headers=structure(list(
          'content-type'="text/csv; charset=utf-8",
-         'location'=url
+         'location'=gsub('\\/api\\/', '', url)
        ),
        class = c("insensitive", "list")),
   class = "response")
@@ -29,10 +29,11 @@ test_that(
   "connectAndCheck deals with redirect 301 status",
   {
     redirectCall <- TRUE
+    redirect$status_code = 301L
     stub(connectAndCheck, "makeApiCall", function(...)
       if(redirectCall) { redirectCall <<- FALSE; redirect  } else {makeApiCall(...)})
 
-    rcon <- connectAndCheck(rcon$token, "https://test.xyz/api")
+    rcon <- connectAndCheck(rcon$token, "https://test.xyz/api/")
     expect_equal(rcon$url, url)
   }
 )
@@ -44,7 +45,7 @@ test_that(
     stub(connectAndCheck, "makeApiCall", function(...)
       if(redirectCall) { redirectCall <<- FALSE; redirect  } else {makeApiCall(...)})
 
-    rcon <- connectAndCheck(rcon$token, "https://test.xyz/api")
+    rcon <- connectAndCheck(rcon$token, "https://test.xyz/api/")
     expect_equal(rcon$url, url)
   }
 )
@@ -69,7 +70,12 @@ test_that(
 
 test_that(
   "connectAndCheck errors with bad url",
-  expect_error(connectAndCheck("key", "badurl"), "Unable to connect")
+  expect_error(connectAndCheck("key", "badurl"), "Invalid URL provided")
+)
+
+test_that(
+  "connectAndCheck errors with valid url but not a REDCap server",
+  expect_error(connectAndCheck("key", "https://google.com"), "refused connection")
 )
 test_that(
   "unlockREDCap pulls API_KEY and opens connection from keyring returning as list",