EOL Runtime Scanner: Initial Table Edition (posit-dev#163)

* initial version

* adjust version filtering strategy

Author: toph-allen

extensions/eol-runtime-scanner/.Rprofile

@@ -0,0 +1 @@
+source("renv/activate.R")

extensions/eol-runtime-scanner/.gitignore

@@ -0,0 +1 @@
+.posit/

extensions/eol-runtime-scanner/app.R

@@ -0,0 +1,165 @@
+library(shiny)
+library(bslib)
+library(connectapi)
+library(reactable)
+library(dplyr)
+library(shinycssloaders)
+library(lubridate)
+library(bsicons)
+
+source("get_usage.R")
+
+options(
+  spinner.type = 1,
+  spinner.color = "#7494b1"
+)
+
+# Shiny app definition
+
+ui <- page_sidebar(
+  title = "End-of-Life Runtime Scanner",
+
+  sidebar = sidebar(
+    open = TRUE,
+    width = 275,
+
+    selectizeInput(
+      "r_versions",
+      label = "Select R Versions",
+      choices = NULL,
+      multiple = TRUE
+    ),
+
+    selectizeInput(
+      "py_versions",
+      label = "Select Python Versions",
+      choices = NULL,
+      multiple = TRUE
+    ),
+
+    selectizeInput(
+      "quarto_versions",
+      label = "Select Quarto Versions",
+      choices = NULL,
+      multiple = TRUE
+    )
+  ),
+
+  withSpinner(reactableOutput("content_table"))
+)
+
+server <- function(input, output, session) {
+  client <- connect()
+
+  content <- reactive({
+    content <- get_content(client) |>
+      filter(
+        !if_all(c(r_version, py_version, quarto_version), is.na)
+      )
+  })
+
+  observeEvent(
+    content(),
+    {
+      rv <- sort(unique(content()$r_version))
+      pv <- sort(unique(content()$py_version))
+      qv <- sort(unique(content()$quarto_version))
+
+      updateSelectizeInput(
+        session,
+        "r_versions",
+        choices = rv,
+        selected = character(0)
+      )
+      updateSelectizeInput(
+        session,
+        "py_versions",
+        choices = pv,
+        selected = character(0)
+      )
+      updateSelectizeInput(
+        session,
+        "quarto_versions",
+        choices = qv,
+        selected = character(0)
+      )
+    },
+    ignoreNULL = TRUE
+  )
+
+  usage <- reactive({
+    get_usage(
+      client,
+      from = today() - days(6),
+      to = today()
+    ) |>
+      group_by(content_guid) |>
+      summarize(hits = n())
+  })
+
+  content_filtered <- reactive({
+    df <- content()
+    rv <- input$r_versions
+    pv <- input$py_versions
+    qv <- input$quarto_versions
+
+    df |>
+      filter(
+        (length(rv) > 0 & r_version %in% rv) |
+          (length(pv) > 0 & py_version %in% pv) |
+          (length(qv) > 0 & quarto_version %in% qv) |
+          (length(rv) == 0 & length(pv) == 0 & length(qv) == 0)
+      )
+  })
+
+  content_table_data <- reactive({
+    content_filtered() |>
+      select(
+        guid,
+        title,
+        app_mode,
+        r_version,
+        py_version,
+        quarto_version,
+        dashboard_url
+      ) |>
+      left_join(usage(), by = c("guid" = "content_guid"))
+  })
+
+  output$content_table <- renderReactable({
+    data <- content_table_data()
+
+    reactable(
+      data,
+      defaultPageSize = 25,
+      columns = list(
+        guid = colDef(name = "GUID"),
+        title = colDef(name = "Title"),
+        app_mode = colDef(name = "App Mode"),
+        r_version = colDef(name = "R Version"),
+        py_version = colDef(name = "Python Version"),
+        quarto_version = colDef(name = "Quarto Version"),
+        dashboard_url = colDef(
+          name = "",
+          width = 32,
+          sortable = FALSE,
+          cell = function(url) {
+            if (is.na(url) || url == "") return("")
+            HTML(as.character(tags$div(
+              onclick = "event.stopPropagation()",
+              tags$a(
+                href = url,
+                target = "_blank",
+                bsicons::bs_icon("arrow-up-right-square")
+              )
+            )))
+          },
+          html = TRUE
+        ),
+        hits = colDef(name = "Hits in Last Week")
+      )
+    )
+  })
+}
+
+shinyApp(ui, server)

extensions/eol-runtime-scanner/get_usage.R

@@ -0,0 +1,39 @@
+library(connectapi)
+
+NA_datetime_ <- vctrs::new_datetime(NA_real_, tzone = "UTC")
+NA_list_ <- list(list())
+
+usage_dtype <- tibble::tibble(
+  "id" = NA_integer_,
+  "user_guid" = NA_character_,
+  "content_guid" = NA_character_,
+  "timestamp" = NA_datetime_,
+  "data" = NA_list_
+)
+
+to_iso8601 <- function(x) {
+  strftime(x, "%Y-%m-%dT%H:%M:%S%z") |>
+    sub("([+-]\\d{2})(\\d{2})$", "\\1:\\2", x = _)
+}
+
+get_usage <- function(client, from = NULL, to = NULL) {
+  # Allow us to pass in either dates or specific timestamps.
+  if (is.Date(from)) {
+    from <- as.POSIXct(paste(from, "00:00:00"), tz = "")
+  }
+  if (is.Date(to)) {
+    to <- as.POSIXct(paste(to, "23:59:59"), tz = "")
+  }
+  from_timestamp <- to_iso8601(from)
+  to_timestamp <- to_iso8601(to)
+
+  usage_raw <- client$GET(
+    connectapi:::v1_url("instrumentation", "content", "hits"),
+    query = list(
+      from = from_timestamp,
+      to = to_timestamp
+    )
+  )
+  usage_parsed <- connectapi:::parse_connectapi_typed(usage_raw, usage_dtype)
+  usage_parsed[c("user_guid", "content_guid", "timestamp")]
+}