imotionsApi v2.9.6 - Remove credential for S3 calls retrieval using online

.github/workflows/workflow.yml

@@ -2,7 +2,7 @@ name: R test, lint & check, build, release
 
 on:
   pull_request:
-    types: [opened, synchronize, closed]
+    types: [opened, synchronize]
     branches:
       - main
   push:
@@ -59,7 +59,7 @@ jobs:
         run: echo "datetime=$(date +'%Y%m%d-%H%M%S')" >> $GITHUB_OUTPUT
         shell: bash
 
-      - name: Fix version number for snapshot
+      - name: Set version number for non-release build
         if: ${{ github.event_name != 'push' || !startsWith(github.ref, 'refs/tags/v') }}
         run: |
           sed -i 's/0000000000/${{ steps.date.outputs.datetime }}/' imotionsApi/DESCRIPTION
@@ -100,17 +100,6 @@ jobs:
           working-directory: './imotionsApi'
           args: 'c("--no-manual", "--as-cran", "--no-multiarch")'
 
-      - name: Publish snapshot
-        uses: softprops/action-gh-release@v1
-        if: ${{ github.event_name == 'workflow_dispatch' || (github.event_name == 'pull_request' && github.event.action == 'closed' && github.event.pull_request.merged == true) }}
-        with:
-          tag_name: "snapshot-${{ steps.date.outputs.datetime }}"
-          prerelease: true
-          name: "Snapshot ${{ steps.date.outputs.datetime }}"
-          files: |
-            LICENSE
-            ./imotionsApi/check/*.tar.gz
-
       - name: Publish tagged release
         uses: softprops/action-gh-release@v1
         if: ${{ github.event_name == 'push' && startsWith(github.ref, 'refs/tags/v') }}

imotionsApi/DESCRIPTION

@@ -1,7 +1,7 @@
 Package: imotionsApi
 Type: Package
 Title: iMotions R library
-Version: 2.9.5-0000000000
+Version: 2.9.6-0000000000
 Date: 2026-07-08
 Authors@R: c(
 	person("Amandine", "Grappe", role = "aut"),

imotionsApi/R/imotionsApi.R

@@ -252,11 +252,10 @@ getSegment <- function(study, segmentId) {
 #' Retrieves detailed information about stimuli in the study.
 #'
 #' @param study An imStudy object as returned from \code{\link{imStudy}}.
+#' @param respondent Optional - An imRespondent object as returned from \code{\link{getRespondents}}.
 #' @param relevant A boolean indicating whether only relevant stimuli should be kept, by default non-relevant stimuli
 #'                 are discarded.
 #'
-#' @param respondent Optional - An imRespondent object as returned from \code{\link{getRespondents}}.
-#'
 #' @return An imStimulusList object (data.table) containing all stimuli from the study.
 #' @export
 #' @examples
@@ -1775,7 +1774,8 @@ privateGetAoiDetails <- function(study, imObject, respondent = NULL) {
             return(imObject)
         }
 
-        AOIDetails <- getJSON(study$connection, imObject$fileId, message = paste("Retrieving details for", endpoint))
+        AOIDetails <- getJSON(study$connection, imObject$fileId, message = paste("Retrieving details for", endpoint),
+                              auth = FALSE)
 
         # Give a warning in case some AOIs data are missing due to IVT issues
         if (length(AOIDetails) == 0) {
@@ -3040,13 +3040,14 @@ getRespondentAnnotationsUrl <- function(study, respondent) {
 #' @param url The url/path where the JSON file is located.
 #' @param message Optional - a short message indicating which steps are getting performed to get a more indicative
 #'                error message.
+#' @param auth Whether to add the bearer token to the request, by default it is added to the request.
 #'
 #' @param ... Optional - arguments passed to jsonlite::fromJSON.
 #'
 #' @return The retrieved JSON file.
 #' @keywords internal
-getJSON <- function(connection, url, message = NULL, ...) {
-    response <- getHttr(connection, url, message)
+getJSON <- function(connection, url, message = NULL, auth = TRUE, ...) {
+    response <- getHttr(connection, url, message, auth = auth)
     text <- content(x = response, as = "text", encoding = "UTF-8")
     return(fromJSON(txt = text, ...))
 }
@@ -3083,7 +3084,7 @@ getFile <- function(connection, url, message = NULL, fileName = NULL, localFileP
         dir.create(dirname(file_path), showWarnings = FALSE, recursive = TRUE)
         tmp_path <- paste0(file_path, ".part")
 
-        getHttr(connection, url, message, writePath = tmp_path)
+        getHttr(connection, url, message, writePath = tmp_path, auth = connection$localIM)
         file.rename(tmp_path, file_path)
     } else {
         message("Retrieving local data for ", file_path)
@@ -3140,7 +3141,7 @@ csvHeaders <- function() httr::add_headers("Content-Type" = "text/csv")
 jsonHeaders <- function() httr::add_headers("Content-Type" = "application/json")
 
 
-#' Perform a GET HTTP request with authentication.
+#' Perform a GET HTTP request with optional authentication.
 #'
 #' The request will be retried up to 3 times if an error is encountered.
 #'
@@ -3149,10 +3150,11 @@ jsonHeaders <- function() httr::add_headers("Content-Type" = "application/json")
 #' @param message Optional - a short message indicating which steps are getting performed to get a more indicative
 #'                error message.
 #' @param writePath Optional - A local path where the response body should be streamed.
+#' @param auth Whether to add the bearer token to the request, by default it is added to the request.
 #'
 #' @return The last response.
 #' @keywords internal
-getHttr <- function(connection, url, message = NULL, writePath = NULL) {
+getHttr <- function(connection, url, message = NULL, writePath = NULL, auth = TRUE) {
     if (connection$localIM) {
         # Locally there is no point to retry request if we get a 404 not found error
         terminate_on <- 404
@@ -3161,7 +3163,8 @@ getHttr <- function(connection, url, message = NULL, writePath = NULL) {
     }
 
     output <- if (is.null(writePath)) httr::write_memory() else httr::write_disk(writePath, overwrite = TRUE)
-    response <- retryHttr(message, "GET", url, tokenHeaders(connection$token), output, terminate_on = terminate_on)
+    config <- if (auth) tokenHeaders(connection$token) else httr::add_headers()
+    response <- retryHttr(message, "GET", url, config, output, terminate_on = terminate_on)
 
     return(response)
 }

imotionsApi/tests/testthat/test-getAOIRespondentData.R

@@ -25,7 +25,9 @@ stimulus <- getStimuli(study)[4, ]
 respondent_cloud <- getRespondents(study_cloud)[1, ]
 stimulus_cloud <- getStimuli(study)[4, ]
 
-mockedPrivateGetAoiDetails <- function(study, imObject, expected_endpoint, respondent = NULL, expectedAOICall = 1) {
+mockedPrivateGetAoiDetails <- function(study, imObject, expected_endpoint, respondent = NULL, expectedAOICall = 1,
+                                       expectedAuth = TRUE) {
+
     # Replace url to load test data
     mockUrl <- function(study, url) {
         if (!study$connection$localIM) {
@@ -62,8 +64,13 @@ mockedPrivateGetAoiDetails <- function(study, imObject, expected_endpoint, respo
     expect_called(getJSON_Stub, expectedAOICall)
 
     if (expectedAOICall > 0) {
-        expect_args(getJSON_Stub, 1, connection = study$connection, url = expectedUrl,
-                    message = paste("Retrieving details for", expected_endpoint))
+        if (expectedAuth) {
+            expect_args(getJSON_Stub, 1, connection = study$connection, url = expectedUrl,
+                        message = paste("Retrieving details for", expected_endpoint))
+        } else {
+            expect_args(getJSON_Stub, 1, connection = study$connection, url = expectedUrl,
+                        message = paste("Retrieving details for", expected_endpoint), auth = FALSE)
+        }
     }
 
     return(AOIdetails)
@@ -142,7 +149,7 @@ expectedNames <- c("stimId", "respId", "startMediaOffset", "endMediaOffset", "ao
 
 test_that("remote return - AOI details for a specific AOI", {
     expected_endpoint <- "AOI: El Manuel Area"
-    aoiDetails <- mockedPrivateGetAoiDetails(study_cloud, AOI_cloud, expected_endpoint)
+    aoiDetails <- mockedPrivateGetAoiDetails(study_cloud, AOI_cloud, expected_endpoint, expectedAuth = FALSE)
 
     expect_equal(nrow(aoiDetails), 3, info = "3 respondents should have the AOI defined")
     expect_named(aoiDetails, expectedNames, info = "aoi details infos not matching")
@@ -152,7 +159,8 @@ test_that("remote return - AOI details for a specific AOI", {
 test_that("remote return - AOI details for a specific AOI/respondent", {
     respondent <- getRespondents(study_cloud)[1, ]
     expected_endpoint <- "AOI: El Manuel Area, Respondent: bab55356-43fc-4c25-a39d-a1d513965614"
-    aoiDetails <- mockedPrivateGetAoiDetails(study_cloud, AOI_cloud, expected_endpoint, respondent)
+    aoiDetails <- mockedPrivateGetAoiDetails(study_cloud, AOI_cloud, expected_endpoint, respondent,
+                                             expectedAuth = FALSE)
 
     expect_equal(nrow(aoiDetails), 1, info = "only the respondent of interest should be kept")
     expect_named(aoiDetails, expectedNames, info = "aoi details infos not matching")
@@ -168,7 +176,8 @@ AOIDetailsPath_cloud <- "../data/AOIDetails_failed.json"
 test_that("remote warning - failed to generate AOI details", {
     expected_endpoint <- "AOI: El Manuel Area"
 
-    expect_warning(aoiDetails <- mockedPrivateGetAoiDetails(study_cloud, AOI_cloud, expected_endpoint),
+    expect_warning(aoiDetails <- mockedPrivateGetAoiDetails(study_cloud, AOI_cloud, expected_endpoint,
+                                                            expectedAuth = FALSE),
                    "AOI: El Manuel Area in/out file generation failed, check the IVT data.",
                    info = "no AOI defined for this respondent should throw an error")
 
@@ -347,7 +356,7 @@ test_that("local check - work if no AOI exposure", {
 
 respondent <- getRespondents(study_cloud)[1, ]
 expected_endpoint <- "AOI: El Manuel Area, Respondent: bab55356-43fc-4c25-a39d-a1d513965614"
-aoiDetails <- mockedPrivateGetAoiDetails(study_cloud, AOI_cloud, expected_endpoint, respondent)
+aoiDetails <- mockedPrivateGetAoiDetails(study_cloud, AOI_cloud, expected_endpoint, respondent, expectedAuth = FALSE)
 aoiDetails_inout <- mockedPrivateGetAoiDetails(study_cloud, AOI_cloud_inout, expected_endpoint, respondent,
                                                expectedAOICall = 0)
 
@@ -410,7 +419,9 @@ respondent$id <- "7dbdca47-3d70-4d1c-86ba-372f34e20948"
 
 
 test_that("remote return - intervals should work on dynamic AOIs", {
-    aoiDetails <- mockedPrivateGetAoiDetails(study_cloud, AOI_cloud, expected_endpoint, respondent)
+    aoiDetails <- mockedPrivateGetAoiDetails(study_cloud, AOI_cloud, expected_endpoint, respondent,
+                                             expectedAuth = FALSE)
+
     AOIintervals <- mockedGetAoiRespondentData(study_cloud, AOI_cloud, respondent, aoiDetails)$intervals
 
     # Check AOI intervals as for remote study dynamic AOIs start with an non-activated row

imotionsApi/tests/testthat/test-httrRequests.R

@@ -91,13 +91,14 @@ test_that("error - invalid response", {
 # getHttr =============================================================================================================
 context("getHttr()")
 
-mockedGetHttr <- function(connection, url, mockResponse, terminate_on, writePath = NULL) {
-    config <- tokenHeaders(connection$token)
+mockedGetHttr <- function(connection, url, mockResponse, terminate_on, writePath = NULL, auth = TRUE) {
+    config <- if (auth) tokenHeaders(connection$token) else httr::add_headers()
+
     output <- if (is.null(writePath)) httr::write_memory() else httr::write_disk(writePath, overwrite = TRUE)
     retryHttr_Stub <- mock(mockResponse)
 
     response <- mockr::with_mock(retryHttr = retryHttr_Stub, {
-        getHttr(connection, url, "Test API", writePath = writePath)
+        getHttr(connection, url, "Test API", writePath = writePath, auth = auth)
     })
 
     expect_args(retryHttr_Stub, 1, "Test API", "GET", url, config, output, terminate_on)
@@ -119,25 +120,27 @@ test_that("remote/local check - should work correctly", {
     expect_identical(response, mockResponse, "response should not have been modified")
 })
 
-test_that("remote check - should stream a GET response to the requested file", {
+test_that("remote check - should stream an unauthenticated GET response to the requested file", {
     mockResponse$status_code <- 200
     class(mockResponse) <- "response"
 
-    response <- mockedGetHttr(connection_cloud, "url", mockResponse, terminate_on = NULL, writePath = "download.part")
+    response <- mockedGetHttr(connection_cloud, "url", mockResponse, terminate_on = NULL, writePath = "download.part",
+                              auth = FALSE)
+
     expect_identical(response, mockResponse, "response should not have been modified")
 })
 
 # getJSON =============================================================================================================
 context("getJSON()")
 
-mockedGetJSON <- function(connection, url, mockResponse) {
+mockedGetJSON <- function(connection, url, mockResponse, auth = TRUE) {
     getHttr_Stub <- mock(mockResponse)
 
     data <- mockr::with_mock(getHttr = getHttr_Stub, {
-        getJSON(connection, url, "Test API")
+        getJSON(connection, url, "Test API", auth = auth)
     })
 
-    expect_args(getHttr_Stub, 1, connection, url, "Test API")
+    expect_args(getHttr_Stub, 1, connection, url, "Test API", auth = auth)
     return(data)
 }
 
@@ -151,6 +154,9 @@ test_that("return - JSON file if a good request has been sent", {
     #in case of good request - send back a JSON file
     data <- mockedGetJSON(connection, "url", mockResponse)
     expect_equal(data, expectedReturn, info = "wrong object returned")
+
+    data <- mockedGetJSON(connection, "url", mockResponse, auth = FALSE)
+    expect_equal(data, expectedReturn, info = "wrong object returned without authentication")
 })
 
 # getFile =============================================================================================================
@@ -159,8 +165,11 @@ context("getFile()")
 # Get the sensors through the cloud
 sensors_cloud <- suppressWarnings(jsonlite::unserializeJSON(readLines("../data/imSensorList_cloud.json")))
 
-mockGetFile <- function(connection, url, mockResponse, fileName = NULL, localFilePath = NULL) {
-    getHttr_Stub <- function(connection, url, message, writePath = NULL) {
+mockGetFile <- function(connection, url, mockResponse, expectedAuth, fileName = NULL, localFilePath = NULL) {
+
+    getHttr_Stub <- function(connection, url, message, writePath = NULL, auth = TRUE) {
+        expect_equal(auth, expectedAuth)
+
         # Mimic write_disk() by copying the fixture to the requested path.
         file.copy(sub("^file://", "", mockResponse$url), writePath, overwrite = TRUE)
         return(mockResponse)
@@ -180,7 +189,7 @@ test_that("remote check - should call getHttr and return the correct file paths"
     mockResponse <- list(headers = list("content-type" = "application/zip"), url = url)
     class(mockResponse) <- "response"
 
-    fileInfos <- mockGetFile(connection_cloud, url, mockResponse, eyetracking_fileName)
+    fileInfos <- mockGetFile(connection_cloud, url, mockResponse, FALSE, eyetracking_fileName)
 
     expected_path <- paste0("ProgramData/iMotions/Lab_NG/Data/RRRock The R/Signals/",
                             "20e73a6c-f2ae-4146-90f7-1430bbc9857b/ET_Eyetracker.csv")
@@ -198,7 +207,7 @@ test_that("remote check - should call getHttr and return the correct file paths"
     mockResponse <- list(headers = list("content-type" = "application/octet-stream"), url = url)
     class(mockResponse) <- "response"
 
-    fileInfos <- mockGetFile(connection_cloud, url, mockResponse, events_fileName)
+    fileInfos <- mockGetFile(connection_cloud, url, mockResponse, FALSE, events_fileName)
 
     expected_path <- file.path(fileInfos$tmp_dir, "Native_SlideEvents_cloud.csv")
     expect_identical(fileInfos$file_path, expected_path, "wrong file found")
@@ -208,19 +217,29 @@ test_that("remote check - should call getHttr and return the correct file paths"
     expect_false(file.exists(fileInfos$file_path), info = "file should have been deleted")
 })
 
-test_that("remote check - should call getHttr and download a file to an explicit local path", {
+test_that("remote/local check - should call getHttr and download a file to an explicit local path", {
+    # Case without authentificator
     url <- "https://s3.test/respondent-aoi-metrics.csv"
     expected_path <- tempfile("aoi-metrics-cache-", fileext = ".csv")
     mockResponse <- list(headers = list("content-type" = "text/csv"), url = "file://../data/AOImetrics.csv")
     class(mockResponse) <- "response"
 
-    fileInfos <- mockGetFile(connection_cloud, url, mockResponse, localFilePath = expected_path)
+    fileInfos <- mockGetFile(connection_cloud, url, mockResponse, FALSE, localFilePath = expected_path)
 
     expect_identical(fileInfos$file_path, expected_path, "wrong file found")
 
     expect_true(file.exists(expected_path))
     unlink(expected_path)
     expect_false(file.exists(expected_path))
+
+    # Case with authentificator
+    url <- "http://localhost:8086/api/content/respondent-aoi-metrics.csv"
+    fileInfos <- mockGetFile(connection, url, mockResponse, TRUE, localFilePath = expected_path)
+
+    expect_identical(fileInfos$file_path, expected_path, "wrong local file found")
+    expect_true(file.exists(expected_path))
+    unlink(expected_path)
+    expect_false(file.exists(expected_path))
 })
 
 test_that("remote check - should call getHttr and reuse a file from an explicit local path", {
@@ -257,7 +276,7 @@ test_that("remote error - should not promote a partial download", {
     on.exit(unlink(paste0(expected_path, ".part")), add = TRUE)
 
     expect_error(
-        mockr::with_mock(getHttr = function(connection, url, message, writePath = NULL) {
+        mockr::with_mock(getHttr = function(connection, url, message, writePath = NULL, auth = TRUE) {
             writeBin(charToRaw("partial"), writePath)
             stop("Network error")
         }, {