Add same site directive

Author: oreshinya

example/Main.purs

@@ -3,7 +3,7 @@ module Main where
 import Prelude
 
 import Bucketchain (createServer, listen)
-import Bucketchain.Header.Cookie (addCookie, getCookies)
+import Bucketchain.Header.Cookie (SameSite(..), addCookie, getCookies)
 import Bucketchain.Header.Vary (addVary)
 import Bucketchain.Http (requestMethod, requestURL)
 import Bucketchain.Middleware (Middleware)
@@ -44,6 +44,7 @@ middleware next = do
         , maxAge: Just 60
         , secure: false
         , httpOnly: true
+        , sameSite: Just Lax
         }
       pure Nothing
     else next

src/Bucketchain/Header/Cookie.purs

@@ -1,5 +1,6 @@
 module Bucketchain.Header.Cookie
   ( Cookie
+  , SameSite(..)
   , addCookie
   , getCookies
   ) where
@@ -23,8 +24,21 @@ type Cookie =
   , maxAge :: Maybe Int
   , secure :: Boolean
   , httpOnly :: Boolean
+  , sameSite :: Maybe SameSite
   }
 
+-- | The SameSite directive.
+data SameSite
+  = Strict
+  | Lax
+
+derive instance eqSameSite :: Eq SameSite
+derive instance ordSameSite :: Ord SameSite
+
+instance showSameSite :: Show SameSite where
+  show Strict = "Strict"
+  show Lax = "Lax"
+
 -- | Add a cookie.
 addCookie :: Http -> Cookie -> Effect Unit
 addCookie http pld =
@@ -35,6 +49,7 @@ addCookie http pld =
 toField :: Cookie -> String
 toField pld =
   joinWith "; "
+    <<< setSameSite pld
     <<< setHttpOnly pld
     <<< setSecure pld
     <<< setMaxAge pld
@@ -72,6 +87,12 @@ setHttpOnly pld xs =
     then snoc xs "HttpOnly"
     else xs
 
+setSameSite :: Cookie -> Array String -> Array String
+setSameSite pld xs =
+  case pld.sameSite of
+    Nothing -> xs
+    Just s -> snoc xs $ "SameSite=" <> show s
+
 -- | Get cookies.
 getCookies :: Http -> Object String
 getCookies http =