From bec1b5a7a985f8cfe13514d940a44df3bb442a1a Mon Sep 17 00:00:00 2001
From: Dave Aitken <dave.aitken@gmail.com>
Date: Thu, 20 Sep 2018 11:31:16 +0100
Subject: [PATCH 1/2] Expose all cookie directives, use cookie_hdr repr
 internally

---
 opium_kernel/cookie.ml  | 22 +++++++++-------------
 opium_kernel/cookie.mli |  8 ++++++++
 2 files changed, 17 insertions(+), 13 deletions(-)

diff --git a/opium_kernel/cookie.ml b/opium_kernel/cookie.ml
index 93579436..69c60969 100644
--- a/opium_kernel/cookie.ml
+++ b/opium_kernel/cookie.ml
@@ -15,10 +15,10 @@ module Env = struct
 end
 
 module Env_resp = struct
-  type cookie = (string * string * Co.Cookie.expiration) list
+  type cookie = Co.Cookie.Set_cookie_hdr.t list
   let key : cookie Hmap0.key =
     Hmap0.Key.create
-      ("cookie_res",[%sexp_of: (string * string * Co.Cookie.expiration) list])
+      ("cookie_res",[%sexp_of: Co.Cookie.Set_cookie_hdr.t list])
 end
 
 let current_cookies env record =
@@ -53,30 +53,26 @@ let get req ~key =
     |> List.find_map ~f:(fun (k,v) ->
       if k = key then Some (decode v) else None)
 
-let set_cookies ?(expiration = `Session) resp cookies =
+let set_cookies ?expiration ?path ?domain ?secure ?http_only resp cookies =
   let env = Rock.Response.env resp in
   let current_cookies = current_cookies_resp (fun r->r.Rock.Response.env) resp in
-  let cookies' = List.map cookies ~f:(fun (key, data) -> (key, data, expiration)) in
+  let cookies' = List.map cookies ~f:(fun (key, data) ->
+    Co.Cookie.Set_cookie_hdr.make ?path ?domain ?expiration ?secure ?http_only (key, encode data)) in
   (* WRONG cookies cannot just be concatenated *)
   let all_cookies = current_cookies @ cookies' in
   { resp with Rock.Response.env=(Hmap0.add Env_resp.key all_cookies env) }
 
-let set ?expiration resp ~key ~data =
-  set_cookies ?expiration resp [(key, data)]
+let set ?expiration ?path ?domain ?secure ?http_only resp ~key ~data =
+  set_cookies ?expiration ?path ?domain ?secure ?http_only resp [(key, data)]
 
-let m =             (* TODO: "optimize" *)
+let m = (* TODO: "optimize" *)
   let filter handler req =
     handler req >>| fun response ->
     let cookie_headers =
       let module Cookie = Co.Cookie.Set_cookie_hdr in
-      let f (k, v, expiration) =
-        (k, encode v)
-        |> Cookie.make ~path:"/" ~expiration
-        |> Cookie.serialize
-      in
       response
       |> current_cookies_resp (fun r -> r.Rock.Response.env)
-      |> List.map ~f
+      |> List.map ~f:Cookie.serialize
     in
     let old_headers = Rock.Response.headers response in
     { response with Rock.Response.headers=(
diff --git a/opium_kernel/cookie.mli b/opium_kernel/cookie.mli
index 9b433878..15a2ac3d 100644
--- a/opium_kernel/cookie.mli
+++ b/opium_kernel/cookie.mli
@@ -9,6 +9,10 @@ val get : Rock.Request.t -> key:string -> string option
 (** Set the value of a cookie with a certain key in a response *)
 val set
   : ?expiration:Cohttp.Cookie.expiration
+  -> ?path:string
+  -> ?domain:string
+  -> ?secure:bool
+  -> ?http_only:bool
   -> Rock.Response.t
   -> key:string
   -> data:string
@@ -17,6 +21,10 @@ val set
 (** Like set but will do multiple cookies at once *)
 val set_cookies
   : ?expiration:Cohttp.Cookie.expiration
+  -> ?path:string
+  -> ?domain:string
+  -> ?secure:bool
+  -> ?http_only:bool
   -> Rock.Response.t
   -> (string * string) list
   -> Rock.Response.t

From 8a5b265258167fd8512f02c43ba06823a87e75d0 Mon Sep 17 00:00:00 2001
From: Dave Aitken <dave.aitken@gmail.com>
Date: Wed, 26 Sep 2018 14:18:33 +0100
Subject: [PATCH 2/2] Keep the "/" cookie default

---
 opium_kernel/cookie.ml | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/opium_kernel/cookie.ml b/opium_kernel/cookie.ml
index 69c60969..19cf31c7 100644
--- a/opium_kernel/cookie.ml
+++ b/opium_kernel/cookie.ml
@@ -53,11 +53,12 @@ let get req ~key =
     |> List.find_map ~f:(fun (k,v) ->
       if k = key then Some (decode v) else None)
 
-let set_cookies ?expiration ?path ?domain ?secure ?http_only resp cookies =
+(* Path defaulted to "/" as otherwise the default is the path of the request's URI *)
+let set_cookies ?expiration ?(path = "/") ?domain ?secure ?http_only resp cookies =
   let env = Rock.Response.env resp in
   let current_cookies = current_cookies_resp (fun r->r.Rock.Response.env) resp in
   let cookies' = List.map cookies ~f:(fun (key, data) ->
-    Co.Cookie.Set_cookie_hdr.make ?path ?domain ?expiration ?secure ?http_only (key, encode data)) in
+    Co.Cookie.Set_cookie_hdr.make ~path ?domain ?expiration ?secure ?http_only (key, encode data)) in
   (* WRONG cookies cannot just be concatenated *)
   let all_cookies = current_cookies @ cookies' in
   { resp with Rock.Response.env=(Hmap0.add Env_resp.key all_cookies env) }