feat: Add {otel} support

.Renviron

@@ -0,0 +1,7 @@
+OTEL_TRACES_EXPORTER=${LOGFIRE_OTEL_TRACES_EXPORTER}
+OTEL_EXPORTER_OTLP_ENDPOINT=${LOGFIRE_OTEL_EXPORTER_OTLP_ENDPOINT}
+OTEL_EXPORTER_OTLP_HEADERS=${LOGFIRE_OTEL_EXPORTER_OTLP_HEADERS}
+OTEL_LOGS_EXPORTER=${LOGFIRE_OTEL_LOGS_EXPORTER}
+OTEL_LOG_LEVEL=${LOGFIRE_OTEL_LOG_LEVEL}
+OTEL_METRICS_EXPORTER=${LOGFIRE_OTEL_METRICS_EXPORTER}
+OTEL_ENV=dev

.vscode/settings.json

@@ -6,6 +6,7 @@
   "[r]": {
     "files.trimTrailingWhitespace": true,
     "files.insertFinalNewline": true,
+    "editor.formatOnSave": false,
   },
   "[typescript]": {
     "editor.defaultFormatter": "esbenp.prettier-vscode",

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: shiny
 Title: Web Application Framework for R
-Version: 1.11.1.9000
+Version: 1.11.1.9001
 Authors@R: c(
     person("Winston", "Chang", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0002-1576-2126")),
@@ -94,7 +94,8 @@ Imports:
     later (>= 1.0.0),
     lifecycle (>= 0.2.0),
     mime (>= 0.3),
-    promises (>= 1.3.2),
+    otel,
+    promises (>= 1.3.3.9006),
     R6 (>= 2.0),
     rlang (>= 0.4.10),
     sourcetools,
@@ -114,6 +115,7 @@ Suggests:
     magrittr,
     markdown,
     mirai,
+    otelsdk (>= 0.2.0),
     ragg,
     reactlog (>= 1.0.0),
     rmarkdown,
@@ -122,6 +124,8 @@ Suggests:
     testthat (>= 3.2.1),
     watcher,
     yaml
+Remotes:
+    rstudio/promises
 Config/Needs/check: shinytest2
 Config/testthat/edition: 3
 Encoding: UTF-8
@@ -133,6 +137,7 @@ Collate:
     'app_template.R'
     'bind-cache.R'
     'bind-event.R'
+    'bind-otel.R'
     'bookmark-state-local.R'
     'bookmark-state.R'
     'bootstrap-deprecated.R'
@@ -185,6 +190,12 @@ Collate:
     'modal.R'
     'modules.R'
     'notifications.R'
+    'otel-attr-srcref.R'
+    'otel-label.R'
+    'otel-reactive-update.R'
+    'otel-session.R'
+    'otel-with.R'
+    'otel.R'
     'priorityqueue.R'
     'progress.R'
     'react.R'

NAMESPACE

@@ -388,9 +388,12 @@ importFrom(promises,"%...!%")
 importFrom(promises,"%...>%")
 importFrom(promises,as.promise)
 importFrom(promises,is.promising)
+importFrom(promises,local_ospan_promise_domain)
 importFrom(promises,promise)
 importFrom(promises,promise_reject)
 importFrom(promises,promise_resolve)
+importFrom(promises,with_ospan_async)
+importFrom(promises,with_ospan_promise_domain)
 importFrom(rlang,"%||%")
 importFrom(rlang,"fn_body<-")
 importFrom(rlang,"fn_fmls<-")

NEWS.md

@@ -1,5 +1,25 @@
 # shiny (development version)
 
+## OpenTelemetry support (#4269)
+
+* Added support for [OpenTelemetry](https://opentelemetry.io/) tracing via [`{otel}`](https://otel.r-lib.org/index.html). By default, if `otel::is_tracing_enabled()` returns `TRUE`, then `{shiny}` will record all OpenTelemetery spans. To disable adjust the default `{shiny}` behavior, set the option `shiny.otel.bind` to `"none"` (or environment variable to `SHINY_OTEL_BIND=none`). See [`{otelsdk}`'s Collecting Telemetry Data](https://otelsdk.r-lib.org/reference/collecting.html) for more details on configuring OpenTelemetry.
+
+* Spans are recorded for:
+  * `session_start`: Wraps the calling of the `server()` function. Also contains HTTP request within the attributes.
+  * `session_end`: Wraps the calling of the `onSessionEnded()` handlers.
+  * `reactive_update`: Signals the start of when Shiny knows something is to be calculated. This span ends when there are no more reactive updates (promises or synchronous) to be calculated.
+  * `reactive`, `observe`, `output`: Captures the calculation (including any async promise chains) of a reactive expression (`reactive()`), an observer (`observe()`), or an output render function (`render*()`).
+  * `ExtendedTask`: Captures the calculation (including any async promise chains) of an `ExtendedTask`.
+
+* OpenTelemetry Logs are recorded for:
+  * `Set reactiveVal <name>` - When a `reactiveVal()` is set
+  * `Set reactiveValues <name>$<key>` - When a `reactiveValues()` element is set
+  * Fatal or unhandled errors - When an error occurs that causes the session to end, or when an unhandled error occurs in a reactive context. Contains the error within the attributes. To unsantize the error message being collected, set `options(shiny.otel.sanitize.errors = FALSE)`.
+  * `Set ExtendedTask <name> <value>` - When an `ExtendedTask`'s respective reactive value (e.g., `status`, `value`, and `error`) is set.
+  * `<ExtendedTask name> add to queue` - When an `ExtendedTask` is added to the task queue.
+
+* All logs and spans contain the `session.id` attribute.
+
 ## New features
 
 * The `icon` argument of `updateActionButton()`/`updateActionLink()` nows allows values other than `shiny::icon()` (e.g., `fontawesome::fa()`, `bsicons::bs_icon()`, etc). (#4249)
@@ -10,9 +30,11 @@
 
 * Fixed an issue where `updateSelectizeInput(options = list(plugins="remove_button"))` could lead to multiple remove buttons. (#4275)
 
+* The default label for `reactiveValues()` will not attempt to retrieve the assigned name if the srcref is available. If a value can not easily be produced, the default label (`reactiveValuesXXXX`) will be used instead. (#4269)
+
 ## Changes
 
-* The return value of `actionButton()`/`actionLink()` changed slightly: `label` and `icon` are wrapped in an additional HTML container element. This allows for: 1. `updateActionButton()`/`updateActionLink()` to distinguish between the `label` and `icon` when making updates and 2. spacing between `label` and `icon` to be more easily customized via CSS. 
+* The return value of `actionButton()`/`actionLink()` changed slightly: `label` and `icon` are wrapped in an additional HTML container element. This allows for: 1. `updateActionButton()`/`updateActionLink()` to distinguish between the `label` and `icon` when making updates and 2. spacing between `label` and `icon` to be more easily customized via CSS.
 
 # shiny 1.11.1
 

R/bind-cache.R

@@ -478,7 +478,7 @@ bindCache.default <- function(x, ...) {
 bindCache.reactiveExpr <- function(x, ..., cache = "app") {
   check_dots_unnamed()
 
-  label <- exprToLabel(substitute(key), "cachedReactive")
+  label <- exprToLabel(substitute(x), "cachedReactive")
   domain <- reactive_get_domain(x)
 
   # Convert the ... to a function that returns their evaluated values.
@@ -494,8 +494,8 @@ bindCache.reactiveExpr <- function(x, ..., cache = "app") {
   rm(x)
   # Hacky workaround for issue with `%>%` preventing GC:
   # https://github.com/tidyverse/magrittr/issues/229
-  if (exists(".GenericCallEnv") && exists(".", envir = .GenericCallEnv)) {
-    rm(list = ".", envir = .GenericCallEnv)
+  if (exists(".GenericCallEnv") && exists(".", envir = .GenericCallEnv, inherits = FALSE)) {
+    rm(list = ".", envir = .GenericCallEnv, inherits = FALSE)
   }
 
 

R/bind-event.R

@@ -199,28 +199,39 @@ bindEvent.reactiveExpr <- function(x, ..., ignoreNULL = TRUE, ignoreInit = FALSE
   label <- label %||%
     sprintf('bindEvent(%s, %s)', attr(x, "observable", exact = TRUE)$.label, quos_to_label(qs))
 
+  x_classes <- class(x)
+
   # Don't hold on to the reference for x, so that it can be GC'd
   rm(x)
 
   initialized <- FALSE
 
-  res <- reactive(label = label, domain = domain, ..stacktraceon = FALSE, {
-    hybrid_chain(
-      eventFunc(),
-      function(value) {
-        if (ignoreInit && !initialized) {
-          initialized <<- TRUE
-          req(FALSE)
-        }
+  without_otel_bind({
+    res <- reactive(label = label, domain = domain, ..stacktraceon = FALSE, {
+      hybrid_chain(
+        {
+          eventFunc()
+        },
+        function(value) {
+          if (ignoreInit && !initialized) {
+            initialized <<- TRUE
+            req(FALSE)
+          }
 
-        req(!ignoreNULL || !isNullEvent(value))
+          req(!ignoreNULL || !isNullEvent(value))
 
-        isolate(valueFunc())
-      }
-    )
+          isolate(valueFunc())
+        }
+      )
+    })
   })
 
-  class(res) <- c("reactive.event", class(res))
+  class(res) <- c("reactive.event", x_classes)
+
+  if (has_otel_bind("reactivity")) {
+    res <- bind_otel_reactive_expr(res)
+  }
+
   res
 }
 
@@ -302,6 +313,9 @@ bindEvent.Observer <- function(x, ..., ignoreNULL = TRUE, ignoreInit = FALSE,
   )
 
   class(x) <- c("Observer.event", class(x))
+  if (has_otel_bind("reactivity")) {
+    x <- bind_otel_observe(x)
+  }
   invisible(x)
 }
 

R/bind-otel.R

@@ -0,0 +1,186 @@
+# - OpenTelemetry -----------------------------------
+# * Integration locations:
+#   * √ Server:
+#     * Start reactive_update when reactive busy count > 0
+#     * End reactive_update when reactive busy count == 0
+#   * √ Reactives: val, values, expr, render fn, observe
+#   * Combinations:
+#     * √ debounce() / throttle()
+#     * bindCache()
+#     * √ bindEvent()
+#     * X - bindProgress()
+#   * Special functions:
+#     * ExtendedTask()
+#       * Extended task links to submission reactive
+#       * Reactive update that gets result links to the extended task
+#     * √ observeEvent()
+#     * √ eventReactive()
+#       * TODO: Not recording updates within the span!!
+#  * Maybe enhance all `withReactiveDomain()` calls?
+# * Global options:
+#   * √ shiny.otel.bind:
+#     * "all", "none" - all or nothing
+#     * Current non-public options:
+#       * "session" - Adds session start/end events
+#       * "reactive_update" - Spans for any reactive update. (Includes `"session"` features).
+#       * "reactivity" - Spans for all reactive things. (Includes `"reactive_update"` features).
+# * Private methods:
+#   * bind_otel_*() - Methods that binds the reactive object to OpenTelemetry spans
+#     * Note: When adding otel to an object, prepend a class of `FOO.otel`. Then add a dispatch method for `bindOtel.FOO.otel()` that declares the object already has been bound.
+#   * without_otel_bind(expr) - Will not bind any reactives created within `expr` to OpenTelemetry spans.
+
+# - TODO: -----------------------------------
+# * Span status for success/failure (render function and regular reactive exprs?)
+# * Error handling is not an "exception" for fatal logs
+# * Connect `user.id` to be their user name: https://opentelemetry.io/docs/specs/semconv/registry/attributes/user/
+# * Tests with otel recording
+
+
+
+# - Questions -----------------------------------
+# Add error handling for every otel. Use withCallingHandlers similar to https://github.com/r-lib/mirai/pull/395/files#diff-9e809582679952a93b9f34755bb38207471945eb36cedb9e2aa755125449f531R214-R215
+
+# TODO: Extended Tasks are linked from parent span. Maybe use an envvar for span context? It is allowed for child process can end much later than the parent process. Take inspiration from callr PR (copying of the span context to the child process).
+
+# ------------------------------------------
+
+# # Approach
+# Use flags on the reactive object to indicate whether to record OpenTelemetry spans.
+#
+# Cadence:
+# * `$.isRecordingOtel` - Whether to record OpenTelemetry spans for this reactive object
+# * `$.otelLabel` - The label to use for the OpenTelemetry span
+# * `$.otelAttrs` - Additional attributes to add to the OpenTelemetry span
+
+
+#' Add OpenTelemetry for reactivity to an object
+#'
+#' @description
+#'
+#' `bindOtel()` adds OpenTelemetry for [reactive()] expressions and `render*`
+#' functions (like [renderText()], [renderTable()], ...).
+#'
+#' Wrapper to creating an active reactive OpenTelemetry span that closes when
+#' the reactive expression is done computing. Typically this is when the
+#' reactive expression finishes (synchronous) or when the returned promise is
+#' done computing (asynchronous).
+
+#' @section Async with OpenTelemetry:
+#'
+#'   With a reactive expression, the key and/or value expression can be
+#'   _asynchronous_. In other words, they can be promises --- not regular R
+#'   promises, but rather objects provided by the
+#'   \href{https://rstudio.github.io/promises/}{\pkg{promises}}  package, which
+#'   are similar to promises in JavaScript. (See [promises::promise()] for more
+#'   information.) You can also use [mirai::mirai()] or [future::future()]
+#'   objects to run code in a separate process or even on a remote machine.
+#'
+#'   When reactive expressions are being calculated in parallel (by having
+#'   another reactive promise compute in the main process), the currently active
+#'   OpenTelemetry span will be dynamically swapped out according to the
+#'   currently active reactive expression. This means that as long as a promise
+#'   was `then()`ed or `catch()`ed with an active OpenTelemetry span, the span
+#'   will be correctly propagated to the next step (and subsequently other
+#'   steps) in the promise chain.
+#'
+#'   While the common case is for a reactive expression to be created
+#'   synchronously, troubles arise when the reactive expression is created
+#'   asynchronously. The span **must** be created before the reactive expression
+#'   is executed, it **must** be active for the duration of the expression, and
+#'   it **must** not be closed until the reactive expression is done executing.
+#'   This is not easily achieved with a single function call, so we provide a
+#'   way to create a reactive expression that is bound to an OpenTelemetry
+#'   span.
+#'
+#' @param x The object to add caching to.
+#' @param ... Future parameter expansion.
+#' @seealso [bindCache()] and [bindEvent()] for other ways to bind to your reactives.
+#' @noRd
+NULL
+
+bind_otel_reactive_val <- function(x) {
+
+  impl <- attr(x, ".impl", exact = TRUE)
+  # Set flag for otel logging when setting the value
+  impl$.isRecordingOtel <- TRUE
+
+  class(x) <- c("reactiveVal.otel", class(x))
+
+  x
+}
+
+bind_otel_reactive_values <- function(x) {
+
+  impl <- .subset2(x, "impl")
+  # Set flag for otel logging when setting values
+  impl$.isRecordingOtel <- TRUE
+
+  class(x) <- c("reactivevalues.otel", class(x))
+
+  x
+}
+
+bind_otel_reactive_expr <- function(x) {
+
+  domain <- reactive_get_domain(x)
+
+  impl <- attr(x, "observable", exact = TRUE)
+  impl$.isRecordingOtel <- TRUE
+  # Covers both reactive and reactive.event
+  impl$.otelLabel <- ospan_label_reactive(x, domain = impl$.domain)
+
+  class(x) <- c("reactiveExpr.otel", class(x))
+
+  x
+}
+
+bind_otel_observe <- function(x) {
+  x$.isRecordingOtel <- TRUE
+  x$.otelLabel <- ospan_label_observer(x, domain = x$.domain)
+
+  class(x) <- c("Observer.otel", class(x))
+  invisible(x)
+}
+
+
+
+bind_otel_shiny_render_function <- function(x) {
+  if (inherits(x, "shiny.render.function.otel")) {
+    # Already bound
+    return(x)
+  }
+
+  valueFunc <- x
+  span_label <- NULL
+  ospan_attrs <- attr(x, "otelAttrs")
+
+  renderFunc <- function(...) {
+    # Dynamically determine the span label given the current reactive domain
+    if (is.null(span_label)) {
+      span_label <<-
+        ospan_label_render_function(x, domain = getDefaultReactiveDomain())
+    }
+
+    with_shiny_ospan_async(
+      span_label,
+      {
+        valueFunc(...)
+      },
+      attributes = ospan_attrs
+    )
+  }
+
+  renderFunc <- addAttributes(renderFunc, renderFunctionAttributes(valueFunc))
+  class(renderFunc) <- c("shiny.render.function.otel", class(valueFunc))
+  renderFunc
+}
+
+
+
+# bindOtel.function <- function(x, ...) {
+#   cli::cli_abort(paste0(
+#     "Don't know how to add OpenTelemetry recording to a plain function. ",
+#     "If this is a {.code render*()} function for Shiny, it may need to be updated. ",
+#     "Please see {.help shiny::bindOtel} for more information."
+#   ))
+# }