context("Sessions") skip_if_no_cookie_support <- function() { skip_if_not_installed("sodium") skip_if_not_installed("base64enc") } make_req_cookie <- function(verb, path, cookie) { req <- new.env() req$REQUEST_METHOD <- toupper(verb) req$PATH_INFO <- path req$rook.input <- list(read_lines = function() { "" }, rewind = function() {}, read = function() { charToRaw("") }) if (!missing(cookie)){ req$HTTP_COOKIE <- cookie } req } test_that("session_cookie throws missing key", { expect_error( session_cookie(), "You must define an encryption key" ) }) test_that("cookies are set", { skip_if_no_cookie_support() r <- pr() expr <- expression(function(req, res){ req$session <- list(abc = 1234); TRUE }) r$handle("GET", "/", expr) key <- random_cookie_key() sc <- session_cookie( key, name = "plcook" ) r$registerHooks(sc) res <- PlumberResponse$new() r$serve(make_req_cookie("GET", "/"), res) cook <- res$headers[["Set-Cookie"]] expect_match(cook, "^plcook") cook <- parseCookies(cook)$plcook expect_equal(decodeCookie(cook, asCookieKey(key)), list(abc = 1234)) }) test_that("cookies are unset", { skip_if_no_cookie_support() r <- pr() exprRemoveSession <- expression(function(req, res){ req$session <- NULL; TRUE }) r$handle("GET", "/", exprRemoveSession) key <- random_cookie_key() sc <- session_cookie( key, name = "plcook" ) r$registerHooks(sc) res <- PlumberResponse$new() r$serve( make_req_cookie( "GET", "/", # start with a session cookie paste0("plcook=", encodeCookie(list(abc = 1234), asCookieKey(key))) ), res ) cook <- res$headers[["Set-Cookie"]] expect_match(cook, "^plcook=;") expect_true(grepl("Thu, 01 Jan 1970", cook, fixed = TRUE)) }) test_that("cookies are read", { skip_if_no_cookie_support() r <- pr() expr <- expression(function(req, res){ req$session$abc }) r$handle("GET", "/", expr) key <- random_cookie_key() sc <- session_cookie( key, name = "plcook" ) r$registerHooks(sc) # Create the request with an encrypted cookie res <- PlumberResponse$new() r$serve( make_req_cookie( "GET", "/", # start with a session cookie paste0("plcook=", encodeCookie(list(abc = 1234), asCookieKey(key))) ), res ) expect_equal(res$body, jsonlite::toJSON(1234)) }) test_that("invalid cookies/JSON are handled", { skip_if_no_cookie_support() r <- pr() expr <- expression(function(req, res){ ifelse(is.null(req$session), "no session", req$session) }) r$handle("GET", "/", expr) key <- random_cookie_key() sc <- session_cookie( key, name = "plcook" ) r$registerHooks(sc) res <- PlumberResponse$new() badKey <- random_cookie_key() x <- list(abc = 1234) encodedX <- encodeCookie(x, asCookieKey(badKey)) expect_silent({ r$serve( make_req_cookie( "GET", "/", paste0('plcook=', encodedX) ), res ) }) expect_equal(res$body, jsonlite::toJSON("no session")) }) test_that("cookie attributes are set", { skip_if_no_cookie_support() r <- pr() expr <- expression(function(req, res){ req$session <- list(abc = 1234); TRUE }) r$handle("GET", "/", expr) key <- random_cookie_key() sc <- session_cookie( key, name = "plcook", expiration = 10, http = TRUE, secure = TRUE, same_site = "None" ) r$registerHooks(sc) res <- PlumberResponse$new() r$serve(make_req_cookie("GET", "/"), res) cook <- res$headers[["Set-Cookie"]] expect_match(cook, "^plcook") expect_match(cook, "Expires=[^;]+(?:;|$)") expect_match(cook, "Max-Age=\\s*\\d+(?:;|$)") expect_match(cook, "HttpOnly(?:;|$)") expect_match(cook, "Secure(?:;|$)") expect_match(cook, "SameSite=None(?:;|$)") cook <- parseCookies(cook)$plcook expect_equal(decodeCookie(cook, asCookieKey(key)), list(abc = 1234)) })