Adds tracking for returning anonymous users #142

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: shiny.telemetry
 Title: 'Shiny' App Usage Telemetry
-Version: 0.2.0.9002
+Version: 0.2.0.9004
 Authors@R: c(
     person("André", "Veríssimo", , "[email protected]", role = c("aut", "cre")),
     person("Kamil", "Żyła", , "[email protected]", role = "aut"),

NEWS.md

@@ -4,6 +4,7 @@
 
 - Updated `get_user` method to retrieve user in `shinyproxy` environment (#124).
 - Added flexibility to select between [`RPostgreSQL`, `RPostgres`] drivers (#147).
+- Added tracking for returning anonymous users (#142).
 
 ### Miscellaneous
 

R/telemetry.R

@@ -109,6 +109,10 @@ Telemetry <- R6::R6Class( # nolint object_name_linter
     #' Shiny session.
     #' @param username Character with username. If set, it will overwrite username
     #' from session object.
+    #' @param track_anonymous_user flag that indicates to track anonymous user.
+    #' A cookie is used to track same user without login over multiple sessions,
+    #' This is only activated if none of the automatic methods produce a username
+    #' and when a username is not explicitly defined.`TRUE` by default
     #'
     #' @return Nothing. This method is called for side effects.
 
@@ -120,18 +124,20 @@ Telemetry <- R6::R6Class( # nolint object_name_linter
       browser_version = TRUE,
       navigation_input_id = NULL,
       session = shiny::getDefaultReactiveDomain(),
-      username = NULL
+      username = NULL,
+      track_anonymous_user = TRUE
     ) {
 
       checkmate::assert_flag(track_inputs)
       checkmate::assert_flag(track_values)
       checkmate::assert_flag(login)
       checkmate::assert_flag(logout)
       checkmate::assert_flag(browser_version)
+      checkmate::assert_flag(track_anonymous_user)
 
       checkmate::assert_character(navigation_input_id, null.ok = TRUE)
 
-      username <- private$get_user(session, username)
+      username <- private$get_user(session, username, track_anonymous_user)
 
       checkmate::assert(
         .combine = "or",
@@ -715,18 +721,52 @@ Telemetry <- R6::R6Class( # nolint object_name_linter
         )
       }
     },
-
+    extract_cookie = function(cookie_string, cookie_name = "shiny_user_cookie") {
+      checkmate::assert_string(cookie_string, null.ok = TRUE)
+      checkmate::assert_string(cookie_name, null.ok = FALSE)
+      if (is.null(cookie_string)) return(NULL)
+      cookies <- strsplit(cookie_string, ";")[[1]]
+      cookies <- trimws(cookies)
+      for (cookie in cookies) {
+        parts <- strsplit(cookie, "=")[[1]]
+        if (length(parts) == 2 && parts[1] == cookie_name) {
+          # Check if the value looks like a SHA256 hash
+          cookie_value <- parts[2]
+          if (grepl("^[a-f0-9]{64}$", cookie_value)) {
+            return(cookie_value)
+          }
+        }
+      }
+      NULL
+    },
     get_user = function(
       session = shiny::getDefaultReactiveDomain(),
-      force_username = NULL
+      force_username = NULL,
+      track_anonymous_user = TRUE
     ) {
       if (!is.null(force_username)) return(force_username)
       if (isFALSE(is.null(session)) && isFALSE(is.null(session$user))) {
-        return(session$user) # POSIT Connect
+        session$user # POSIT Connect
       } else if (nzchar(Sys.getenv("SHINYPROXY_USERNAME"))) {
-        return(Sys.getenv("SHINYPROXY_USERNAME"))
+        Sys.getenv("SHINYPROXY_USERNAME")
+      } else if (track_anonymous_user) {
+        cookie_value <- private$extract_cookie(cookie_string = session$request$HTTP_COOKIE)
+        # cookie_value will be NULL if either not found or not generated using SHA256 algorithm.
+        if (is.null(cookie_value)) {
+          cookie_string <- paste0(
+            session$request$HTTP_USER_AGENT,
+            session$request$REMOTE_ADDR, Sys.time()
+          )
+          cookie_value <- digest::digest(cookie_string, algo = "sha256")
+          session$sendCustomMessage("setUserCookie", list(
+            cookieName = "shiny_user_cookie",
+            cookieValue = cookie_value,
+            expiryInDays = 365
+          ))
+        }
+        cookie_value
       } else {
-        return(NULL)
+        NULL
       }
     }
   )

R/ui_elements.R

@@ -11,8 +11,6 @@ use_telemetry <- function(id = "") {
   if (id != "" && !is.null(id)) {
     shiny_namespace <- glue::glue("{id}-")
   }
-
-
   shiny::tagList(
     shiny::tags$script(
       type = "text/javascript",
@@ -40,6 +38,20 @@ use_telemetry <- function(id = "") {
   });
       "
       ))
+    ),
+    htmltools::htmlDependency(
+      name = "js-cookie",
+      version = "1.0.0",
+      src = "js",
+      package = "shiny.telemetry",
+      script = "js.cookie.min.js"
+    ),
+    htmltools::htmlDependency(
+      name = "manage-cookie",
+      version = "1.0.0",
+      src = "js",
+      package = "shiny.telemetry",
+      script = "manage-cookies.js"
     )
   )
 }

inst/js/manage-cookies.js

@@ -0,0 +1,3 @@
+ Shiny.addCustomMessageHandler('setUserCookie', function(params) {
+      Cookies.set(params.cookieName, params.cookieValue,{expires: params.expiryInDays, path: '/'});
+  });