Add laxSameSiteSessions and strictSameSiteSessions

yesod-core/Yesod/Core.hs

@@ -53,6 +53,8 @@ module Yesod.Core
     , envClientSessionBackend
     , clientSessionBackend
     , sslOnlySessions
+    , laxSameSiteSessions
+    , strictSameSiteSessions
     , sslOnlyMiddleware
     , clientSessionDateCacher
     , loadClientSession

yesod-core/Yesod/Core/Class/Yesod.hs

@@ -49,7 +49,7 @@ import qualified Text.Blaze.Html5                   as TBH
 import           Text.Hamlet
 import           Text.Julius
 import qualified Web.ClientSession                  as CS
-import           Web.Cookie                         (parseCookies)
+import           Web.Cookie                         (parseCookies, sameSiteLax, sameSiteStrict, SameSiteOption)
 import           Web.Cookie                         (SetCookie (..))
 import           Yesod.Core.Types
 import           Yesod.Core.Internal.Session
@@ -366,6 +366,22 @@ sslOnlySessions = (fmap . fmap) secureSessionCookies
     setSecureBit cookie = cookie { setCookieSecure = True }
     secureSessionCookies = customizeSessionCookies setSecureBit
 
+-- | Helps defend against CSRF attacks by setting the SameSite attribute on
+-- session cookies to "Lax".
+laxSameSiteSessions :: IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
+laxSameSiteSessions = sameSiteSession sameSiteLax
+
+-- | Helps defend against CSRF attacks by setting the SameSite attribute on
+-- session cookies to "Strict".
+strictSameSiteSessions :: IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
+strictSameSiteSessions = sameSiteSession sameSiteStrict
+
+sameSiteSession :: SameSiteOption -> IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
+sameSiteSession s = (fmap . fmap) secureSessionCookies
+  where
+    sameSite cookie = cookie { setCookieSameSite = (pure s) }
+    secureSessionCookies = customizeSessionCookies sameSite
+
 -- | Apply a Strict-Transport-Security header with the specified timeout to
 -- all responses so that browsers will rewrite all http links to https
 -- until the timeout expires. For security, the max-age of the STS header

yesod-core/test/YesodCoreTest.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP                        #-}
-module YesodCoreTest (specs) where 
+module YesodCoreTest (specs) where
 
 import YesodCoreTest.CleanPath
 import YesodCoreTest.Exceptions
@@ -48,4 +48,5 @@ specs = do
       LiteApp.specs
       Ssl.unsecSpec
       Ssl.sslOnlySpec
+      Ssl.sameSiteSpec
       Csrf.csrfSpec

yesod-core/test/YesodCoreTest/Ssl.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
-module YesodCoreTest.Ssl ( sslOnlySpec, unsecSpec ) where
+module YesodCoreTest.Ssl ( sslOnlySpec, unsecSpec, sameSiteSpec ) where
 import qualified YesodCoreTest.StubSslOnly as Ssl
+import qualified YesodCoreTest.StubLaxSameSite as LaxSameSite
+import qualified YesodCoreTest.StubStrictSameSite as StrictSameSite
 import qualified YesodCoreTest.StubUnsecured as Unsecured
 import Yesod.Core
 import Test.Hspec
@@ -62,3 +64,15 @@ unsecSpec = describe "A Yesod application with sslOnly off" $ do
   where
     atHome = homeFixtureFor Unsecured.App
     isNotSecure c = not $ Cookie.setCookieSecure c
+
+sameSiteSpec :: Spec
+sameSiteSpec = describe "A Yesod application" $ do
+    it "can set a Lax SameSite option" $
+        laxHome $ "_SESSION" `cookieShouldSatisfy` isLax
+    it "can set a Strict SameSite option" $
+        strictHome $ "_SESSION" `cookieShouldSatisfy` isStrict
+  where
+    laxHome = homeFixtureFor LaxSameSite.App
+    strictHome = homeFixtureFor StrictSameSite.App
+    isLax = (== Just Cookie.sameSiteLax) . Cookie.setCookieSameSite
+    isStrict = (== Just Cookie.sameSiteStrict) . Cookie.setCookieSameSite

yesod-core/test/YesodCoreTest/StubLaxSameSite.hs

@@ -0,0 +1,23 @@
+{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
+module YesodCoreTest.StubLaxSameSite ( App ( App ) ) where
+
+import Yesod.Core
+import qualified Web.ClientSession                  as CS
+
+data App = App
+
+mkYesod "App" [parseRoutes|
+/ HomeR GET
+|]
+
+instance Yesod App where
+    yesodMiddleware = defaultYesodMiddleware . (sslOnlyMiddleware 120)
+    makeSessionBackend _ = laxSameSiteSessions $
+        fmap Just $ defaultClientSessionBackend 120 CS.defaultKeyFile
+
+getHomeR :: Handler Html
+getHomeR = defaultLayout
+    [whamlet|
+        <p>
+            Welcome to my test application.
+    |]

yesod-core/test/YesodCoreTest/StubStrictSameSite.hs

@@ -0,0 +1,23 @@
+{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
+module YesodCoreTest.StubStrictSameSite ( App ( App ) ) where
+
+import Yesod.Core
+import qualified Web.ClientSession                  as CS
+
+data App = App
+
+mkYesod "App" [parseRoutes|
+/ HomeR GET
+|]
+
+instance Yesod App where
+    yesodMiddleware = defaultYesodMiddleware . (sslOnlyMiddleware 120)
+    makeSessionBackend _ = strictSameSiteSessions $
+        fmap Just $ defaultClientSessionBackend 120 CS.defaultKeyFile
+
+getHomeR :: Handler Html
+getHomeR = defaultLayout
+    [whamlet|
+        <p>
+            Welcome to my test application.
+    |]