## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>", eval = FALSE) ## ----------------------------------------------------------------------------- # library(shiny) # library(brochure) # library(testthat) ## ----------------------------------------------------------------------------- # app <- brochureApp( # page(href = "/", ui = tagList(h1("Home"))), # page(href = "/contact", ui = tagList(h1("Contact"))), # redirect(from = "/index.html", to = "/"), # content_404 = "Nothing here" # ) # # res <- app$httpHandler(mock_req("/contact")) # res$status # #> [1] 200 ## ----------------------------------------------------------------------------- # mock_req <- function(path, method = "GET") { # req <- new.env(parent = emptyenv()) # req$REQUEST_METHOD <- method # req$PATH_INFO <- path # req$QUERY_STRING <- "" # # What makes the dispatch accept this as a request # req$rook.version <- "1.1-0" # req # } ## ----------------------------------------------------------------------------- # test_that("each url reaches its own page", { # expect_match(app$httpHandler(mock_req("/"))$content, "Home") # expect_match(app$httpHandler(mock_req("/contact"))$content, "Contact") # }) # # test_that("an unknown url gets the 404", { # res <- app$httpHandler(mock_req("/nope")) # expect_equal(res$status, 404) # expect_equal(res$content, "Nothing here") # }) # # test_that("the old index redirects home", { # res <- app$httpHandler(mock_req("/index.html")) # expect_equal(res$status, 301) # expect_equal(res$headers$Location, "/") # }) ## ----------------------------------------------------------------------------- # test_that("/who/me is not caught by /who/:id", { # app <- brochureApp( # page(href = "/who/me", ui = tagList(h1("It's you"))), # page(href = "/who/:id", ui = tagList(h1("Someone else"))) # ) # expect_match(app$httpHandler(mock_req("/who/me"))$content, "It's you") # }) ## ----------------------------------------------------------------------------- # test_that("logging in sets the session cookie", { # app <- brochureApp( # page( # href = "/login", # ui = tagList(h1("Logged in")), # res_handlers = list(~ set_cookie(.x, "SESSION", "abc")) # ) # ) # res <- app$httpHandler(mock_req("/login")) # expect_match(res$headers$`Set-Cookie`, "SESSION=abc") # }) ## ----------------------------------------------------------------------------- # test_that("the healthcheck answers 200 without Shiny", { # expect_equal( # app$httpHandler(mock_req("/healthcheck"))$status, # 200 # ) # }) ## ----------------------------------------------------------------------------- # test_that("links stay inside the app under a mount", { # app <- brochureApp( # page(href = "/", ui = tagList(tags$a(href = "/contact", "Contact"))), # basepath = "myapp" # ) # content <- app$httpHandler(mock_req("/myapp/"))$content # expect_match(content, 'href="/myapp/contact"', fixed = TRUE) # }) ## ----------------------------------------------------------------------------- # mock_session <- function(path) { # list( # request = mock_req(path), # sendCustomMessage = function(type, message) NULL # ) # } # # test_that("a session runs the server of its own page", { # ran <- character() # app <- brochureApp( # page(href = "/", ui = tagList(), server = function(i, o, s) ran <<- c(ran, "home")), # page(href = "/page2", ui = tagList(), server = function(i, o, s) ran <<- c(ran, "page2")) # ) # app$serverFuncSource()(NULL, NULL, mock_session("/page2/websocket/")) # expect_equal(ran, "page2") # }) ## ----------------------------------------------------------------------------- # mod_profile_ui <- function(id) { # ns <- NS(id) # tagList(textOutput(ns("name"))) # } # # mod_profile_server <- function(id, user) { # moduleServer(id, function(input, output, session) { # output$name <- renderText(sprintf("Hello %s", user)) # }) # } # # profile <- function() { # page( # href = "/who/:id", # ui = mod_profile_ui("profile"), # server = function(input, output, session) { # # The only line that needs a real session # mod_profile_server("profile", user = get_keys()$id) # } # ) # } ## ----------------------------------------------------------------------------- # test_that("the profile module greets the user", { # testServer(mod_profile_server, args = list(user = "colin"), { # expect_equal(output$name, "Hello colin") # }) # })