From a2c5916ebb92e51a281c9619a209e2574fe8df46 Mon Sep 17 00:00:00 2001 From: Cam Race Date: Mon, 9 Sep 2024 18:21:51 +0100 Subject: [PATCH 1/7] WIP with todo markers --- R/external_link.R | 124 ++++++++++++++++++++++++++++ tests/testthat/test-external_link.R | 29 +++++++ 2 files changed, 153 insertions(+) create mode 100644 R/external_link.R create mode 100644 tests/testthat/test-external_link.R diff --git a/R/external_link.R b/R/external_link.R new file mode 100644 index 0000000..c88ad1f --- /dev/null +++ b/R/external_link.R @@ -0,0 +1,124 @@ +#' External link +#' +#' Intentionally basic wrapper for html anchor elements making it easier to +#' create safe external links with standard and accessible behaviour. +#' +#' @description +#' It is commonplace for external links to open in a new tab, and when we do +#' this we should be careful to avoid [reverse tabnabbing] +#' (https://owasp.org/www-community/attacks/Reverse_Tabnabbing). +#' +#' This function automatically adds the following to your link: +#' * target="_blank" to open in new tab +#' * rel="noopener noreferrer" to prevent reverse tabnabbing +#' +#' By default this function also adds "(opens in new tab)" to your link text +#' to warn users of the behaviour as recommended by +#' [Web Accessibility standards](https://www.w3.org/TR/WCAG20-TECHS/G200.html). +#' +#' This also adds "This link opens in a new tab" as a visually hidden span +#' element within the html outputted to warn non-visual users of the behaviour. +#' +#' @param href URL that you want the link to point to +#' @param link_text Text that will appear describing your link, must be +#' descriptive of the page you are linking to. Vague text like 'click here' or +#' 'here' will cause an error. +#' @param add_warning Boolean for adding "(opens in new tab)" at the end of the +#' link text to warn users of the behaviour. Use with caution and +#' [consider accessibility](https://www.w3.org/TR/WCAG20-TECHS/G200.html) +#' if turning off. +#' +#' @return shiny.tag object +#' @export +#' +#' @examples +#' external_link("https://shiny.posit.co/", "R Shiny") +#' +#' external_link( +#' "https://shiny.posit.co/", +#' "R Shiny", +#' add_warning = FALSE +#' ) +external_link <- function(href, link_text, add_warning = TRUE){ + if(!is.logical(add_warning)){ + stop("add_warning must be a TRUE or FALSE value") + } + + # TODO: tidy this up + # Crude vector for bad link text we should banish into room 101 + bad_text <- c( + "Click here", + "Learn more", + "Read more", + "Further information", + "Click this link", + "Download file", + "Download png", + "Download svg", + "Download jpg", + "Download jpeg", + "Download xslx", + "Download csv", + "Download word", + "Download document", + "Download pdf", + "Web page", + "Web site", + "Download here", + "Go here", + "This page", + + "file", + "pdf", "svg", "jpg", "jpeg", "xslx", "csv", "word", "document", + "Click", + "Here", + "This", + "Form", + "learn", + "More", + "read", + "Information", + "Download", + "File", + "Guidance", + "Link", + "page", + "web", + "page", + "site", + + "Webpage", + "website", + "Dashboard", + "Next", + "previous", + + + ) + + # TODO: add a check for any raw URLs + + if(tolower(link_text) %in% bad_text){ + stop( + paste0( + link_text, + " is not descriptive enough and is has been recognised as bad link ", + " text, please replace the link_text argument with more descriptive", + " text." + ) + ) + } + + if(add_warning){ + link_text <- paste(link_text, "(opens in new tab)") + } + + # Put these through htmltools::tags$a + htmltools::tags$a( + htmltools::span(class = "visually-hidden", "This link opens in a new tab"), + href = href, + link_text, + target="_blank", + rel="noopener noreferrer" + ) +} diff --git a/tests/testthat/test-external_link.R b/tests/testthat/test-external_link.R new file mode 100644 index 0000000..32177e4 --- /dev/null +++ b/tests/testthat/test-external_link.R @@ -0,0 +1,29 @@ +# TODO: add tests + +test_that("Returns shiny.tag object", { + +}) + +test_that("content and URL are correctly formatted", { + +}) + +test_that("New tab warning appends", { + +}) + +test_that("New tab warning always stays for non-visual users", { + +}) + +test_that("rel attributes are attached properly", { + +}) + +test_that("Rejects non-boolean for add_warning", { + expect_error(external_link(add_warning = "Funky non-boolean")) +}) + +test_that("Rejects dodgy link text", { + +}) From 63014fb1899f063edca53ee8a92736d248e560c2 Mon Sep 17 00:00:00 2001 From: Cam Race Date: Mon, 9 Sep 2024 18:24:59 +0100 Subject: [PATCH 2/7] more todo's before I forget --- R/external_link.R | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/R/external_link.R b/R/external_link.R index c88ad1f..e78f2c5 100644 --- a/R/external_link.R +++ b/R/external_link.R @@ -27,7 +27,14 @@ #' link text to warn users of the behaviour. Use with caution and #' [consider accessibility](https://www.w3.org/TR/WCAG20-TECHS/G200.html) #' if turning off. -#' + + +# TODO: point to htmltools tags a object docs and the span ones +# TODO: link to GDS - https://design-system.service.gov.uk/styles/links/ +# TODO: link to MDN details on html elements https://developer.mozilla.org/en-US/docs/Web/HTML/Element/a +# https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/rel/noopener +# https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/rel/noreferrer + #' @return shiny.tag object #' @export #' From 3472da5e52c464ea3db94032510c15d389cb463c Mon Sep 17 00:00:00 2001 From: Cam Race Date: Tue, 10 Sep 2024 09:56:03 +0100 Subject: [PATCH 3/7] finish off external link function --- .Rbuildignore | 1 + DESCRIPTION | 3 + NAMESPACE | 1 + R/data-bad_link_text.R | 16 +++ R/external_link.R | 136 +++++++++-------------- _pkgdown.yml | 16 ++- data-raw/bad_link_text.R | 17 +++ data/bad_link_text.rda | Bin 0 -> 395 bytes man/bad_link_text.Rd | 31 ++++++ man/external_link.Rd | 67 +++++++++++ tests/testthat/test-data-bad_link_text.R | 24 ++++ tests/testthat/test-external_link.R | 44 ++++++-- 12 files changed, 258 insertions(+), 98 deletions(-) create mode 100644 R/data-bad_link_text.R create mode 100644 data-raw/bad_link_text.R create mode 100644 data/bad_link_text.rda create mode 100644 man/bad_link_text.Rd create mode 100644 man/external_link.Rd create mode 100644 tests/testthat/test-data-bad_link_text.R diff --git a/.Rbuildignore b/.Rbuildignore index d681f82..f4e8e2b 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -7,3 +7,4 @@ ^docs$ ^pkgdown$ ^.lintr$ +^data-raw$ diff --git a/DESCRIPTION b/DESCRIPTION index 3f41a2b..0c59ac8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,3 +35,6 @@ RoxygenNote: 7.3.2 URL: https://dfe-analytical-services.github.io/dfeshiny/ https://www.github.com/dfe-analytical-services/dfeshiny/ VignetteBuilder: knitr +Depends: + R (>= 2.10) +LazyData: true diff --git a/NAMESPACE b/NAMESPACE index e8a8dcd..b0e5b76 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(cookies_panel_server) export(cookies_panel_ui) export(custom_disconnect_message) export(dfe_cookies_script) +export(external_link) export(init_analytics) export(init_cookies) export(support_panel) diff --git a/R/data-bad_link_text.R b/R/data-bad_link_text.R new file mode 100644 index 0000000..d1faa68 --- /dev/null +++ b/R/data-bad_link_text.R @@ -0,0 +1,16 @@ +#' Lookup for bad link text +#' +#' A single column data frame, listing out known examples of bad link text that +#' check for in the `external_link()` function. +#' +#' We've started curating this list so we can create automated checks to help +#' all link text to be as descriptive as possible in line with WCAG 2.2 success +#' criteria 2.4.4: Link Purpose (In Context). +#' +#' @format ## `bad_link_text` +#' A data frame with 48 rows and 1 columns: +#' \describe{ +#' \item{bad_link_text}{Lower cased examples of non-descriptive link text} +#' } +#' @source Curated by explore.statistics@@education.gov.uk +"bad_link_text" diff --git a/R/external_link.R b/R/external_link.R index e78f2c5..82f2526 100644 --- a/R/external_link.R +++ b/R/external_link.R @@ -1,40 +1,45 @@ #' External link #' #' Intentionally basic wrapper for html anchor elements making it easier to -#' create safe external links with standard and accessible behaviour. +#' create safe external links with standard and accessible behaviour. For more +#' information on how the tag is generated, see \code{\link[htmltools]{tags}}. #' #' @description #' It is commonplace for external links to open in a new tab, and when we do -#' this we should be careful to avoid [reverse tabnabbing] -#' (https://owasp.org/www-community/attacks/Reverse_Tabnabbing). +#' this we should be careful... #' #' This function automatically adds the following to your link: -#' * target="_blank" to open in new tab -#' * rel="noopener noreferrer" to prevent reverse tabnabbing +#' * `target="_blank"` to open in new tab +#' * `rel="noopener noreferrer"` to prevent reverse tabnabbing #' #' By default this function also adds "(opens in new tab)" to your link text -#' to warn users of the behaviour as recommended by -#' [Web Accessibility standards](https://www.w3.org/TR/WCAG20-TECHS/G200.html). +#' to warn users of the behaviour. #' #' This also adds "This link opens in a new tab" as a visually hidden span #' element within the html outputted to warn non-visual users of the behaviour. #' +#' Related links (aware of the painful irony but couldn't make the +#' documentation work in any other way!)... +#' +#' Government digital services guidelines on the use of links: +#' https://design-system.service.gov.uk/styles/links/ +#' +#' Anchor tag html element and its properties: +#' https://developer.mozilla.org/en-US/docs/Web/HTML/Element/a +#' +#' Web Accessibility standards link text behaviour: +#' https://www.w3.org/TR/WCAG20-TECHS/G200.html +#' +#' Reverse tabnabbing: +#' https://owasp.org/www-community/attacks/Reverse_Tabnabbing +#' #' @param href URL that you want the link to point to #' @param link_text Text that will appear describing your link, must be #' descriptive of the page you are linking to. Vague text like 'click here' or #' 'here' will cause an error. #' @param add_warning Boolean for adding "(opens in new tab)" at the end of the -#' link text to warn users of the behaviour. Use with caution and -#' [consider accessibility](https://www.w3.org/TR/WCAG20-TECHS/G200.html) -#' if turning off. - - -# TODO: point to htmltools tags a object docs and the span ones -# TODO: link to GDS - https://design-system.service.gov.uk/styles/links/ -# TODO: link to MDN details on html elements https://developer.mozilla.org/en-US/docs/Web/HTML/Element/a -# https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/rel/noopener -# https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/rel/noreferrer - +#' link text to warn users of the behaviour. Be careful and consider +#' accessibility before removing the visual warning. #' @return shiny.tag object #' @export #' @@ -42,90 +47,55 @@ #' external_link("https://shiny.posit.co/", "R Shiny") #' #' external_link( -#' "https://shiny.posit.co/", -#' "R Shiny", -#' add_warning = FALSE +#' "https://shiny.posit.co/", +#' "R Shiny", +#' add_warning = FALSE #' ) -external_link <- function(href, link_text, add_warning = TRUE){ - if(!is.logical(add_warning)){ +external_link <- function(href, link_text, add_warning = TRUE) { + if (!is.logical(add_warning)) { stop("add_warning must be a TRUE or FALSE value") } - # TODO: tidy this up - # Crude vector for bad link text we should banish into room 101 - bad_text <- c( - "Click here", - "Learn more", - "Read more", - "Further information", - "Click this link", - "Download file", - "Download png", - "Download svg", - "Download jpg", - "Download jpeg", - "Download xslx", - "Download csv", - "Download word", - "Download document", - "Download pdf", - "Web page", - "Web site", - "Download here", - "Go here", - "This page", - - "file", - "pdf", "svg", "jpg", "jpeg", "xslx", "csv", "word", "document", - "Click", - "Here", - "This", - "Form", - "learn", - "More", - "read", - "Information", - "Download", - "File", - "Guidance", - "Link", - "page", - "web", - "page", - "site", - - "Webpage", - "website", - "Dashboard", - "Next", - "previous", - - - ) + # Create a basic check for raw URLs + is_url <- function(text) { + url_pattern <- "^(https://|http://|www\\.)" + grepl(url_pattern, text) + } - # TODO: add a check for any raw URLs + if (is_url(link_text)) { + stop(paste0( + link_text, + " has been recognise as a raw URL, please change the link_text value to", + " a description of the page being linked to instead" + )) + } - if(tolower(link_text) %in% bad_text){ + # Check against curated data set for link text we should banish into room 101 + if (tolower(link_text) %in% dfeshiny::bad_link_text$bad_link_text) { stop( paste0( link_text, - " is not descriptive enough and is has been recognised as bad link ", + " is not descriptive enough and has has been recognised as bad link", " text, please replace the link_text argument with more descriptive", " text." - ) + ) ) } - if(add_warning){ + if (add_warning) { link_text <- paste(link_text, "(opens in new tab)") + hidden_span <- NULL # don't have extra hidden text if clear in main text + } else { + hidden_span <- + htmltools::span(class = "visually-hidden", "This link opens in a new tab") } - # Put these through htmltools::tags$a + # Create link using htmltools::tags$a htmltools::tags$a( - htmltools::span(class = "visually-hidden", "This link opens in a new tab"), + hidden_span, href = href, link_text, - target="_blank", - rel="noopener noreferrer" + target = "_blank", + rel = "noopener noreferrer" ) } diff --git a/_pkgdown.yml b/_pkgdown.yml index ffe107a..195f9c9 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -6,15 +6,9 @@ template: pkgdown-nav-height: 81.4468px reference: -- title: Maintenance - contents: - - tidy_code - title: Cookies contents: - has_concept("cookies") -- title: Standard panels - contents: - - support_panel - title: Connectivity contents: - custom_disconnect_message @@ -22,3 +16,13 @@ reference: desc: One time functions used to set up or update standardised scripts and workflows needed for your dashboard contents: - starts_with("init") +- title: Links + contents: + - external_link + - bad_link_text +- title: Maintenance + contents: + - tidy_code +- title: Standard panels + contents: + - support_panel diff --git a/data-raw/bad_link_text.R b/data-raw/bad_link_text.R new file mode 100644 index 0000000..4e7568f --- /dev/null +++ b/data-raw/bad_link_text.R @@ -0,0 +1,17 @@ +bad_link_text <- data.frame( + bad_link_text = c( + # one word examples + "click", "csv", "dashboard", "document", "download", "file", "form", + "guidance", "here", "information", "jpeg", "jpg", "learn", "link", "more", + "next", "page", "pdf", "previous", "read", "site", "svg", "this", "web", + "webpage", "website", "word", "xslx", + # two word examples + "click here", "click this link", "download csv", "download document", + "download file", "download here", "download jpg", "download jpeg", + "download pdf", "download png", "download svg", "download word", + "download xslx", "further information", "go here", "learn more", + "read more", "this page", "web page", "web site" + ) +) + +usethis::use_data(bad_link_text, overwrite = TRUE) diff --git a/data/bad_link_text.rda b/data/bad_link_text.rda new file mode 100644 index 0000000000000000000000000000000000000000..e15e6f903d07f9b889d9b0dcd19ac3c8b8f06281 GIT binary patch literal 395 zcmV;60d)RCT4*^jL0KkKS;7~w4*&raf5QI$=m0QR-zp(KORdC#j*JZ6*yt6!NF&r|JYS1Yik~iHV>{q!}pvCYpoFdW=RuGm#t}@CL4+m1VHGv zu`rc17D7_g7_kc>Aus{4Flr1EP-qbkuZ9r|)+yC$?#9bmtzlK_Wt?cs4jE}8ZK~xF zv|4Bv-b$*-X!aB?2kZ#)UdF$yv$V*$F)4e>^NgR~cc=p}>-2^kuA-F$Qqw$9GA1Zx zQ84a3