added telemetry to kinfitr

DESCRIPTION

@@ -9,6 +9,7 @@ Depends:
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
+LazyLoad: no
 RoxygenNote: 7.3.2
 Imports:
     pracma,
@@ -39,7 +40,8 @@ Imports:
     stringr,
     segmented,
     LambertW,
-    rlang
+    rlang,
+    httr2
 Suggests:
     knitr,
     devtools,

Makefile

@@ -0,0 +1,16 @@
+# Makefile
+.PHONY: reload clean install
+
+reload:
+	Rscript -e "if('kinfitr' %in% (.packages())) { detach('package:kinfitr', unload=TRUE); try(unloadNamespace('kinfitr'), silent=TRUE) }; devtools::install('.', force=TRUE); library(kinfitr)"
+
+clean:
+	Rscript -e "remove.packages('kinfitr'); devtools::clean_dll()"
+
+install:
+	Rscript -e "devtools::install('.', force=TRUE)"
+
+interactive:
+	R
+
+debug: reload interactive

NAMESPACE

@@ -146,4 +146,11 @@ export(weights_create)
 export(weights_create_bids)
 import(ggplot2)
 importFrom(dplyr,"%>%")
+importFrom(httr2,req_body_json)
+importFrom(httr2,req_headers)
+importFrom(httr2,req_perform)
+importFrom(httr2,req_retry)
+importFrom(httr2,req_timeout)
+importFrom(httr2,request)
+importFrom(httr2,resp_body_json)
 importFrom(magrittr,"%>%")

R/kinfitr_telemetry.R

@@ -0,0 +1,52 @@
+#' @importFrom httr2 request req_headers req_retry req_timeout req_perform
+#' @importFrom httr2 resp_body_json req_body_json
+
+get_url <- "http://54.144.240.214/check/kinfitr/"
+post_url <- "http://54.144.240.214/kinfitr/"
+
+get_telemetry <- function(url = get_url, number_of_records = 0) {
+  # checks to see what's been posted to the url endpoint, should return location,
+  # and any other data that gets put there with send_telemetry
+  req <- request(paste(url, as.character(number_of_records), sep = ""))
+  req |> req_headers("Accept" = "application/json")
+  req |> req_retry(max_tries = 3)
+  req |> req_timeout(3)
+  response <- req_perform(req)
+  return(resp_body_json(response))
+}
+
+#' Send telemetry data
+#' @keywords internal
+send_telemetry <- function(telemetry_json_data, url = post_url) {
+  # Add debug messages
+  message("Debug: Starting send_telemetry")
+  message("Debug: Telemetry data: ", toString(telemetry_json_data))
+
+  no_track <- Sys.getenv("KINFITR_NO_TRACK")
+  message("Debug: KINFITR_NO_TRACK value: ", no_track)
+
+  if (tolower(no_track) == "true") {
+    message("Debug: Tracking disabled")
+    return(NULL)
+  } else {
+    message("Debug: Attempting to send telemetry")
+    try(
+      {
+        req <- request(url)
+        # Fix the request chain - these need to be assigned
+        req <- req_retry(req, max_tries = 3)
+        req <- req_timeout(req, 3)
+
+        message("Debug: Sending to URL: ", url)
+        response <- req |>
+          req_body_json(data = telemetry_json_data) |>
+          req_perform()
+
+        message("Debug: Response status: ", response$status_code)
+        return_values <- list(status_code = response$status_code)
+        return(return_values)
+      },
+      silent = FALSE # Changed to FALSE to see any errors
+    )
+  }
+}

R/zzz.R

@@ -0,0 +1,29 @@
+.onAttach <- function(libname, pkgname) {
+  message("Loading kinfitr")
+  message("new debug message")
+  # Display opt-out message
+  if (
+      !isTRUE(getOption("kinfitr.no_track")) &&
+        Sys.getenv("KINFITR_NO_TRACK") != "TRUE") {
+    message(
+      "Opt-out of sending tracking information to the KinFitR developers. ",
+      "This information provides an indicator of real world usage crucial for ",
+      "obtaining funding. To disable tracking set ",
+      "options(kinfitr.no_track = TRUE) or the environment variable ",
+      "KINFITR_NO_TRACK to TRUE), to hide this message set ",
+      "options(kinfitr.no_track = FALSE) or the environment variable ",
+      "KINFITR_NO_TRACK to FALSE"
+    )
+  }
+  # # Check if user has opted out
+  if (
+      isTRUE(getOption("kinfitr.no_track")) ||
+        isTRUE(Sys.getenv("KINFITR_NO_TRACK"))) {
+    # do nothing
+    NULL
+  } else {
+    # Send telemetry when package is loaded
+    message("Sending telemetry")
+    send_telemetry(list("kinfitr_usage" = "package_loaded"))
+  }
+}