inst/doc/cookies.R

In brochure: Multipage 'Shiny' Apps

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", eval = FALSE)

## -----------------------------------------------------------------------------
# library(shiny)
# library(brochure)

## -----------------------------------------------------------------------------
# page(
#   href = "/login",
#   ui = tagList(h1("You are logged in")),
#   res_handlers = list(
#     ~ set_cookie(.x, "SESSION", "a-random-id", path = "/")
#   )
# )

## -----------------------------------------------------------------------------
# server <- function(input, output, session) {
#   cookies <- parse_cookie_string(get_cookies())
#   print(cookies["SESSION"])
# }

## -----------------------------------------------------------------------------
# page(
#   href = "/logout",
#   ui = tagList(h1("You are logged out")),
#   res_handlers = list(
#     ~ remove_cookie(.x, "SESSION", path = "/")
#   )
# )

## -----------------------------------------------------------------------------
# store <- cachem::cache_disk()
# 
# # 32 hex characters from the system's cryptographic source. `sample()` would
# # read from R's default generator, whose state is recoverable from its output:
# # fine for a simulation, not for something that has to be unguessable.
# new_session_id <- function() {
#   paste(
#     sprintf("%02x", as.integer(openssl::rand_bytes(16))),
#     collapse = ""
#   )
# }
# 
# login <- function() {
#   page(
#     href = "/login",
#     ui = tagList(h1("Welcome back")),
#     res_handlers = list(
#       # Runs once per request, so each visitor gets an identifier of their own.
#       # Building it in `login()` instead would run it once, when the app is
#       # assembled, and hand every visitor the same session.
#       function(res, req) {
#         id <- new_session_id()
#         store$set(id, list(user = "colin", at = Sys.time()))
#         set_cookie(res, "SESSION", id, path = "/")
#       }
#     )
#   )
# }
# 
# home <- function() {
#   page(
#     href = "/",
#     ui = tagList(h1("Home"), verbatimTextOutput("who")),
#     server = function(input, output, session) {
#       output$who <- renderPrint({
#         # Single brackets: with no Cookie header at all there is nothing to
#         # index into, and `[[` would raise "subscript out of bounds" before
#         # the fallback below is reached.
#         id <- parse_cookie_string(get_cookies())["SESSION"]
#         if (is.na(id)) "anonymous" else store$get(id)
#       })
#     }
#   )
# }