Relax disconnect and cookies

DESCRIPTION

@@ -20,7 +20,6 @@ Imports:
     htmltools,
     lubridate,
     magrittr,
-    RCurl,
     shiny,
     shinyGovstyle,
     shinyjs,

R/cookies.R

@@ -159,8 +159,10 @@ cookies_banner_ui <- function(id = "cookies_banner", name = "DfE R-Shiny dashboa
 #' always be `parent_session = session`
 #' @param google_analytics_key Provide the GA 10 digit key of the form
 #' "ABCDE12345"
-#' @param cookies_link_panel name of the navlistPanel that the cookie banner
+#' @param cookies_link_panel name of the navigation panel that the cookie banner
 #' provides a link to, usually "cookies_panel_ui"
+#' @param cookies_nav_id ID of the navigation panel the cookie panel page is
+#' within, defaults to "navlistPanel"
 #'
 #' @family cookies
 #' @return NULL
@@ -172,7 +174,8 @@ cookies_banner_server <- function(
     input_cookies,
     parent_session,
     google_analytics_key = NULL,
-    cookies_link_panel = "cookies_panel_ui") {
+    cookies_link_panel = "cookies_panel_ui",
+    cookies_nav_id = "navlistPanel") {
   shiny::moduleServer(id, function(input, output, session) {
     if (is.null(google_analytics_key)) {
       warning("Please provide a valid Google Analytics key")
@@ -230,7 +233,7 @@ cookies_banner_server <- function(
       # updateTabsetPanel to have a cookie page for instance
       shiny::updateTabsetPanel(
         session = parent_session,
-        "navlistPanel",
+        inputID = cookies_nav_id,
         selected = cookies_link_panel
       )
     })

R/custom_disconnect_message.R

@@ -11,6 +11,11 @@
 #' @param publication_link The link to the publication on Explore Education
 #' Statistics
 #' @param dashboard_title Title of the dashboard
+#' @param support_contact Email address for support contact, defaults to
+#' explore.statistics@@education.gov.uk
+#' @param custom_refresh Custom refresh link, defaults to refreshing the page, main value is if you
+#' have bookmarking enabled and want the refresh to send to the initial view instead of reloading
+#' any bookmarks
 #'
 #' @importFrom htmltools tags tagList
 #'
@@ -39,14 +44,19 @@
 #'   )
 #' )
 #'
+#' custom_disconnect_message(
+#'   support_contact = "[email protected]",
+#'   custom_refresh = "https://department-for-education.shinyapps.io/my-dashboard"
+#' )
 custom_disconnect_message <- function(
     refresh = "Refresh page",
     dashboard_title = NULL,
     links = NULL,
     publication_name = NULL,
-    publication_link = NULL) {
+    publication_link = NULL,
+    support_contact = "[email protected]",
+    custom_refresh = NULL) {
   # Check links are valid
-
   is_valid_sites_list <- function(sites) {
     lapply(
       stringr::str_trim(sites), startsWith,
@@ -59,27 +69,43 @@ custom_disconnect_message <- function(
     stop("You have entered an invalid site link in the links argument.")
   }
 
+  if (!is.null(custom_refresh)) {
+    is_valid_refresh <- function(refresh) {
+      startsWith(stringr::str_trim(refresh), "https://department-for-education.shinyapps.io/")
+    }
+
+    if (is_valid_refresh(custom_refresh) == FALSE) {
+      stop(
+        paste0(
+          "You have entered an invalid site link in the custom_refresh argument. It must be a site",
+          " on shinyapps.io."
+        )
+      )
+    }
+  }
 
   pub_prefix <- c(
     "https://explore-education-statistics.service.gov.uk/find-statistics/",
     "https://www.explore-education-statistics.service.gov.uk/find-statistics/",
     "https://www.gov.uk/",
-    "https://gov.uk/"
+    "https://gov.uk/",
+    "https://github.com/dfe-analytical-services/"
   )
 
   if (!is.null(publication_link)) {
     is_valid_publication_link <- function(link) {
       startsWith(stringr::str_trim(link), pub_prefix)
     }
 
-    if (RCurl::url.exists(publication_link) == FALSE ||
-      (TRUE %in% is_valid_publication_link(publication_link)) == FALSE || # nolint: [indentation_linter]
-      publication_link %in% pub_prefix) {
+    if (TRUE %in% is_valid_publication_link(publication_link) == FALSE ||
+      publication_link %in% pub_prefix) { # nolint: [indentation_linter]
       stop("You have entered an invalid publication link in the publication_link
          argument.")
     }
   }
 
+  # TODO: Add email validation once a11y panel PR is in
+
   checkmate::assert_string(refresh)
 
   # Attach CSS from inst/www/css/visually-hidden.css
@@ -111,12 +137,22 @@ custom_disconnect_message <- function(
           "Sorry, you have lost connection to the",
           dashboard_title,
           "dashboard at the moment, please ",
-          tags$a(
-            id = "ss-reload-link",
-            href = "#", "refresh the page",
-            onclick = "window.location.reload(true);",
-            .noWS = c("after")
-          ),
+          if (is.null(custom_refresh)) {
+            tags$a(
+              id = "ss-reload-link",
+              href = "#",
+              refresh,
+              onclick = "window.location.reload(true);",
+              .noWS = c("after")
+            )
+          } else {
+            tags$a(
+              id = "ss-reload-link",
+              href = custom_refresh,
+              refresh,
+              .noWS = c("after")
+            )
+          },
           "."
         ),
         if (length(links) > 1) {
@@ -126,21 +162,29 @@ custom_disconnect_message <- function(
             ". Apologies for the inconvenience."
           )
         },
-        if (!is.null(publication_name)) {
+        if (!is.null(publication_name) && grepl("explore-education-statistics", publication_link)) {
           tags$p(
-            "All the data used in this dashboard can also be viewed or downloaded via the ",
+            "The data used in this dashboard can also be viewed or downloaded via the ",
             dfeshiny::external_link(
               href = publication_link,
               publication_name
             ),
-            " on Explore Education Statistics."
+            " on explore education statistics."
+          )
+        } else if (!is.null(publication_name)) {
+          tags$p(
+            "The data used in this dashboard can also be viewed or downloaded from ",
+            dfeshiny::external_link(
+              href = publication_link,
+              publication_name
+            )
           )
         },
         tags$p(
           "Feel free to contact ",
           dfeshiny::external_link(
-            href = "mailto:[email protected]",
-            "[email protected]",
+            href = paste0("mailto:", support_contact),
+            support_contact,
             add_warning = FALSE
           ),
           " if you require further support."

inst/WORDLIST

@@ -6,7 +6,6 @@ DfE
 GDS
 Lifecycle
 README
-RSConnect
 UI
 WCAG
 analytics
@@ -22,6 +21,7 @@ javascript
 js
 lockfile
 md
+nav
 navlistPanel
 pkgdown
 renv

tests/testthat/test-custom_disconnect_message.R

@@ -19,16 +19,7 @@ test_that("publication link is valid", {
     )
   )
 
-  # Test that it fails for non-existent links/typos/random links
-  expect_error(
-    custom_disconnect_message(
-      refresh = "Refresh page",
-      links = "https://department-for-education.shinyapps.io/dfe-shiny-template/", # nolint: [line_length_linter]
-      publication_name = "Pupil attendance in schools",
-      publication_link = "https://explore-education-statistics.service.gov.uk/find-statistics/hello" # nolint: [line_length_linter]
-    )
-  )
-
+  # Test that it fails for a random link
   expect_error(
     custom_disconnect_message(
       refresh = "Refresh page",
@@ -39,7 +30,6 @@ test_that("publication link is valid", {
   )
 
   # Test that just linking to EES homepage fails
-
   expect_error(
     custom_disconnect_message(
       refresh = "Refresh page",
@@ -120,3 +110,72 @@ test_that("site links are valid", {
     )
   )
 })
+
+test_that("Allows GitHub as publication_link and doesn't show EES text", {
+  expect_no_error(
+    custom_disconnect_message(
+      refresh = "Refresh page",
+      links = c(
+        "https://department-for-education.shinyapps.io/dfe-shiny-template/"
+      ),
+      publication_name = "Local authority interactive tool",
+      publication_link = "https://github.com/dfe-analytical-services/local-authority-interactive-tool" # nolint: [line_length_linter]
+    )
+  )
+
+  non_ees <- custom_disconnect_message(
+    refresh = "Refresh page",
+    links = c(
+      "https://department-for-education.shinyapps.io/dfe-shiny-template/"
+    ),
+    publication_name = "Local authority interactive tool",
+    publication_link = "https://github.com/dfe-analytical-services/local-authority-interactive-tool" # nolint: [line_length_linter]
+  )
+
+  expect_false(
+    grepl("explore education statistics", paste0(non_ees), fixed = TRUE)
+  )
+})
+
+test_that("If the link contains EES it uses the EES text", {
+  ees_test <- custom_disconnect_message(
+    refresh = "Refresh page",
+    links = c(
+      "https://department-for-education.shinyapps.io/dfe-shiny-template/"
+    ),
+    publication_name = "Local authority interactive tool",
+    publication_link = "https://www.explore-education-statistics.service.gov.uk/find-statistics/local-authority-interactive-tool" # nolint: [line_length_linter]
+  )
+
+  expect_true(
+    grepl("explore education statistics", paste0(ees_test), fixed = TRUE)
+  )
+})
+
+test_that("Can customise refresh link, but not too much", {
+  expect_no_error(
+    custom_disconnect_message(
+      custom_refresh = "https://department-for-education.shinyapps.io/dfe-shiny-template/",
+    )
+  )
+
+  expect_error(
+    custom_disconnect_message(
+      custom_refresh = "https://www.google.com",
+    ),
+    paste0(
+      "You have entered an invalid site link in the custom_refresh argument.",
+      " It must be a site on shinyapps.io."
+    )
+  )
+
+  expect_error(
+    custom_disconnect_message(
+      custom_refresh = "https://github.com/dfe-analytical-services/dfeshiny",
+    ),
+    paste0(
+      "You have entered an invalid site link in the custom_refresh argument.",
+      " It must be a site on shinyapps.io."
+    )
+  )
+})

vignettes/implementing-cookies.Rmd

@@ -99,6 +99,8 @@ dfeshiny::cookies_panel_server(
 )
 ```
 
+The ID for the UI panels is `navlistPanel`, and this is the default setting in the _server functions, if this ID is different, you will need to set cookie_nav_id in `cookies_panel_server()` to match your ID in the UI.
+
 In the above you should keep all of the flags as they are shown. Note that this 
 assumes you have added `google_analytics_key` as a declared variable in your 
 global.R file. If you've not done this, you'll need to replace