Merge pull request #4 from DavidBarke/master

DESCRIPTION

@@ -11,16 +11,14 @@ Authors@R:
       person(given = "Klaus",
              family = "Hartl",
              role = c("ctb", "cph"),
-             comment = "Author of JS-Cookies"),
-      person(given = "Klaus",
-             family = "Hartl",
-             role = c("ctb", "cph"),
-             comment = "Author of JS-Cookies"))
+             comment = "Author of JS-Cookies")
+    )
 Description: Set and get browser cookies in 'Shiny' through 
     'JS-cookie'.
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.0.2
+RoxygenNote: 7.1.1
 Imports: 
     shiny
+Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -2,6 +2,7 @@
 
 export(Cookie)
 export(add_cookie)
+export(cookie_options)
 export(fetch_cookie)
 export(fetch_cookies)
 export(remove_cookie)

R/cookies.R

@@ -41,68 +41,100 @@ use_glouton <- function(online = TRUE){
 #' `fetch_cookies` returns all the cookies, while `fetch_cookie` search for
 #' one cookie in the browser.
 #'
-#' @param session the `input` and `session` object from Shiny
-#' @param name name of the cookie to set/fetch
-#' @param value the value to set for the cookie
+#' @param session The `session` object passed to function given to
+#'   `shinyServer`. Default is [shiny::getDefaultReactiveDomain()]
+#' @param name Name of the cookie to set/fetch
+#' @param value The value to set for the cookie
+#' @param options A list of options returned from `cookie_options()`. The same
+#'   options that were passed to `add_cookie()` must be passed to
+#'   `remove_cookie()`.
+#' @param debug If `TRUE`, a message is displayed in the browser console after
+#'   adding a cookie.
+#' @param expires Define when the cookie will be removed. Value must be a
+#'   numeric, which will be interpreted as days from time of creation or
+#'   a date. If `NULL`, the cookie becomes a session cookie.
+#' @param path A string indicating the path where the cookie is visible.
+#' @param domain A string indicating a valid domain where the cookie should be
+#'   visible. The cookie will also be visible to all subdomains.
+#' @param secure Boolean indicating whether the cookie transmission requires a
+#'   secure protocol (https).
+#' @param sameSite A string allowing to control whether the browser is sending
+#'   a cookie along with cross-site requests.
 #'
 #' @export
 #' @rdname cookies
 
-fetch_cookies <- function(session = NULL){
-  if(is.null(session))
-    session <- shiny::getDefaultReactiveDomain()
+fetch_cookies <- function(session = shiny::getDefaultReactiveDomain()){
   session$sendCustomMessage("fetchcookies", TRUE)
   return(session$input[["gloutoncookies"]])
 }
 
 #' @export
 #' @rdname cookies
-fetch_cookie <- function(name, session = NULL){
-  if(is.null(session))
-    session <- shiny::getDefaultReactiveDomain()
+fetch_cookie <- function(name, session = shiny::getDefaultReactiveDomain()){
   session$sendCustomMessage("fetchcookie", TRUE)
   return(session$input[["gloutoncookies"]])
 }
 
 #' @export
 #' @rdname cookies
-add_cookie <- function(name, value, session = NULL){
-  if(is.null(session))
-    session <- shiny::getDefaultReactiveDomain()
+add_cookie <- function(name,
+                       value,
+                       options = cookie_options(),
+                       debug = FALSE,
+                       session = shiny::getDefaultReactiveDomain())
+{
   session$sendCustomMessage("addcookie", list(
-    name = name, value = value
+    name = name, value = value, options = options, debug = debug
   ))
 }
 
 #' @export
 #' @rdname cookies
-remove_cookie <- function(name, session = NULL){
-  if(is.null(session))
-    session <- shiny::getDefaultReactiveDomain()
+remove_cookie <- function(name,
+                          options = cookie_options(),
+                          session = shiny::getDefaultReactiveDomain()){
   session$sendCustomMessage("rmcookie", list(
-    name = name
+    name = name, options = options
   ))
 }
 
+#' @export
+#' @rdname cookies
+cookie_options <- function(expires = NULL,
+                           path = "/",
+                           domain = NULL,
+                           secure = FALSE,
+                           sameSite = "strict"
+) {
+  options <- list(
+    expires = expires,
+    path = path,
+    domain = domain,
+    secure = secure,
+    sameSite = sameSite
+  )
+
+  # Drop NULLs
+  options[lengths(options) != 0]
+}
+
 #' Create a Cookie
-#' 
+#'
 #' Create a cookie object.
-#' 
+#'
 #' @export
 Cookie <- R6::R6Class(
   "Cookie",
   public = list(
 #' @details Create a Cookie
-#' 
+#'
 #' @param name The name of the cookie.
 #' @param session A valid Shiny session.
-    initialize = function(name, session = NULL){
+    initialize = function(name, session = shiny::getDefaultReactiveDomain()){
       if(missing(name))
         stop("Missing `name`", call. = FALSE)
 
-      if(is.null(session))
-        session <- shiny::getDefaultReactiveDomain()
-
       private$.session <- session
       private$.name <- name
     },
@@ -113,7 +145,7 @@ Cookie <- R6::R6Class(
       invisible(rez)
     },
 #' @details Set the value of the cookie
-#' 
+#'
 #' @param value Value of the cookie
 #' @param expires When the cookie is set to expire, integer indicating number of days.
 #' @param path Path where cookie is visible.
@@ -127,7 +159,7 @@ Cookie <- R6::R6Class(
       )
 
       private$.session$sendCustomMessage("set-cookie", list(name = private$.name, value = value, options = options))
-      
+
       invisible(self)
     },
 #' @details Remove the cookie.

glouton.Rproj

@@ -18,3 +18,4 @@ StripTrailingWhitespace: Yes
 BuildType: Package
 PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace

inst/example_app.R

@@ -4,26 +4,42 @@ ui <- function(request){
     use_glouton(),
     textInput("cookie_name", "cookie name"),
     textInput("cookie_content", "cookie content"),
+    numericInput("expires_in", "Expires in", min = 0, value = 365),
+    selectInput("sameSite", "sameSite", c("strict", "lax", "none")),
     actionButton("setcookie", "Add cookie"),
-    actionButton("getcookie", "get cookie"),
-    verbatimTextOutput("cook"),
-    verbatimTextOutput("one")
+    p(
+      "Use the developer tools to see the log which is created when debug=TRUE."
+    ),
+    p("Cookies.get():"),
+    verbatimTextOutput("cook")
   )
 }
 
 server <- function(input, output, session){
 
   r <- reactiveValues()
 
-  observeEvent( input$setcookie , {
-    add_cookie(input$cookie_name, input$cookie_content, session)
+  options_r <- shiny::reactive({
+    cookie_options(
+      expires = input$expires_in,
+      path = "/",
+      secure = TRUE,
+      sameSite = input$sameSite
+    )
   })
-  observeEvent( input$getcookie , {
-    r$cook <- fetch_cookies(session, input)
+
+  observeEvent( input$setcookie , {
+    add_cookie(
+      name = input$cookie_name,
+      value = input$cookie_content,
+      options = options_r(),
+      debug = TRUE
+    )
   })
 
   output$cook <- renderPrint({
-    r$cook
+    input$gloutoncookies
+    fetch_cookies(session)
   })
 
 }

inst/glouton.js

@@ -16,7 +16,8 @@ $(document).on('shiny:connected', function(event) {
   });
 
   Shiny.addCustomMessageHandler('addcookie', function(arg) {
-    Cookies.set(arg.name, arg.value);
+    var c = Cookies.set(arg.name, arg.value, arg.options);
+    if (arg.debug) console.log(c);
     sendCookies();
   });