From 6c2e3a1988474a0f7f5661261f50a4b8644c3213 Mon Sep 17 00:00:00 2001 From: bugthunk Date: Tue, 8 Sep 2020 21:05:05 +0200 Subject: [PATCH 1/3] Add support for setting SameSite attribute --- CHANGELOG.md | 5 +++ happstack-server.cabal | 2 +- src/Happstack/Server/Cookie.hs | 3 +- src/Happstack/Server/Internal/Cookie.hs | 43 ++++++++++++++++++++++--- 4 files changed, 46 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 248d555..2df9003 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +7.6.2 +===== + + - added support for specifying SameSite attribute + 7.6.0 ===== diff --git a/happstack-server.cabal b/happstack-server.cabal index 06454eb..292e74b 100644 --- a/happstack-server.cabal +++ b/happstack-server.cabal @@ -1,5 +1,5 @@ Name: happstack-server -Version: 7.6.1 +Version: 7.6.2 Synopsis: Web related tools and services. Description: Happstack Server provides an HTTP server and a rich set of functions for routing requests, handling query parameters, generating responses, working with cookies, serving files, and more. For in-depth documentation see the Happstack Crash Course License: BSD3 diff --git a/src/Happstack/Server/Cookie.hs b/src/Happstack/Server/Cookie.hs index f02aea8..fc4c93a 100644 --- a/src/Happstack/Server/Cookie.hs +++ b/src/Happstack/Server/Cookie.hs @@ -3,6 +3,7 @@ module Happstack.Server.Cookie ( Cookie(..) , CookieLife(..) + , CookieXOriginOption(..) , mkCookie , addCookie , addCookies @@ -12,7 +13,7 @@ module Happstack.Server.Cookie import Control.Monad.Trans (MonadIO(..)) import Happstack.Server.Internal.Monads (FilterMonad, composeFilter) -import Happstack.Server.Internal.Cookie (Cookie(..), CookieLife(..), calcLife, mkCookie, mkCookieHeader) +import Happstack.Server.Internal.Cookie (Cookie(..), CookieLife(..), CookieXOriginOption(..), calcLife, mkCookie, mkCookieHeader) import Happstack.Server.Types (Response, addHeader) -- | Add the 'Cookie' to 'Response'. diff --git a/src/Happstack/Server/Internal/Cookie.hs b/src/Happstack/Server/Internal/Cookie.hs index 2b45b65..2129ffc 100644 --- a/src/Happstack/Server/Internal/Cookie.hs +++ b/src/Happstack/Server/Internal/Cookie.hs @@ -4,6 +4,7 @@ module Happstack.Server.Internal.Cookie ( Cookie(..) , CookieLife(..) + , CookieXOriginOption(..) , calcLife , mkCookie , mkCookieHeader @@ -44,6 +45,7 @@ data Cookie = Cookie , cookieValue :: String , secure :: Bool , httpOnly :: Bool + , sameSiteOpts :: CookieXOriginOption } deriving(Show,Eq,Read,Typeable,Data) -- | Specify the lifetime of a cookie. @@ -60,6 +62,35 @@ data CookieLife | Expired -- ^ cookie already expired deriving (Eq, Ord, Read, Show, Typeable) +-- | Options for specifying third party cookie behaviour. +-- +-- Note that most or all web clients require the cookie to be secure if "none" is +-- specified. +data CookieXOriginOption + = SameSiteLax + -- ^ The cookie is sent in first party contexts as well as linked requests initiated + -- from other contexts. + | SameSiteStrict + -- ^ The cookie is sent in first party contexts only. + | SameSiteNone + -- ^ The cookie is sent in first as well as third party contexts if the cookie is + -- secure. + | SameSiteNoValue + -- ^ The default; used if you do not wish a SameSite attribute present at all. + deriving (Eq, Ord, Typeable, Data) + +instance Show CookieXOriginOption where + show SameSiteLax = "Lax" + show SameSiteStrict = "Strict" + show SameSiteNone = "None" + show SameSiteNoValue = "" + +instance Read CookieXOriginOption where + readsPrec _ "Lax" = [(SameSiteLax, "")] + readsPrec _ "Strict" = [(SameSiteStrict, "")] + readsPrec _ "None" = [(SameSiteNone, "")] + readsPrec _ "" = [(SameSiteNoValue, "")] + -- convert 'CookieLife' to the argument needed for calling 'mkCookieHeader' calcLife :: CookieLife -> IO (Maybe (Int, UTCTime)) calcLife Session = return Nothing @@ -74,13 +105,14 @@ calcLife Expired = -- | Creates a cookie with a default version of 1, empty domain, a --- path of "/", secure == False and httpOnly == False +-- path of "/", secure == False, httpOnly == False and +-- sameSiteOpts == SameSiteNoValue -- -- see also: 'addCookie' mkCookie :: String -- ^ cookie name -> String -- ^ cookie value -> Cookie -mkCookie key val = Cookie "1" "/" "" key val False False +mkCookie key val = Cookie "1" "/" "" key val False False SameSiteNoValue -- | Set a Cookie in the Result. -- The values are escaped as per RFC 2109, but some browsers may @@ -117,8 +149,9 @@ mkCookieHeader mLife cookie = (cookieName cookie++"="++s cookieValue):[ (k++v) | (k,v) <- l, "" /= v ] ++ (if secure cookie then ["Secure"] else []) ++ (if httpOnly cookie then ["HttpOnly"] else []) - - + ++ (if sameSiteOpts cookie /= SameSiteNoValue + then ["SameSite=" ++ (show . sameSiteOpts $ cookie)] + else []) -- | Not an supported api. Takes a cookie header and returns -- either a String error message or an array of parsed cookies @@ -142,7 +175,7 @@ cookiesParser = cookies val<-value path<-option "" $ try (cookieSep >> cookie_path) domain<-option "" $ try (cookieSep >> cookie_domain) - return $ Cookie ver path domain (low name) val False False + return $ Cookie ver path domain (low name) val False False SameSiteNoValue cookie_version = cookie_special "$Version" cookie_path = cookie_special "$Path" cookie_domain = cookie_special "$Domain" From b9f0426c931744ee99dde836fb55514a98d226eb Mon Sep 17 00:00:00 2001 From: bugthunk Date: Tue, 15 Sep 2020 10:21:03 +0200 Subject: [PATCH 2/3] Act on review feedback --- src/Happstack/Server/Cookie.hs | 4 +-- src/Happstack/Server/Internal/Cookie.hs | 33 +++++++++++-------------- 2 files changed, 16 insertions(+), 21 deletions(-) diff --git a/src/Happstack/Server/Cookie.hs b/src/Happstack/Server/Cookie.hs index fc4c93a..ffd6a57 100644 --- a/src/Happstack/Server/Cookie.hs +++ b/src/Happstack/Server/Cookie.hs @@ -3,7 +3,7 @@ module Happstack.Server.Cookie ( Cookie(..) , CookieLife(..) - , CookieXOriginOption(..) + , SameSite(..) , mkCookie , addCookie , addCookies @@ -13,7 +13,7 @@ module Happstack.Server.Cookie import Control.Monad.Trans (MonadIO(..)) import Happstack.Server.Internal.Monads (FilterMonad, composeFilter) -import Happstack.Server.Internal.Cookie (Cookie(..), CookieLife(..), CookieXOriginOption(..), calcLife, mkCookie, mkCookieHeader) +import Happstack.Server.Internal.Cookie (Cookie(..), CookieLife(..), SameSite(..), calcLife, mkCookie, mkCookieHeader) import Happstack.Server.Types (Response, addHeader) -- | Add the 'Cookie' to 'Response'. diff --git a/src/Happstack/Server/Internal/Cookie.hs b/src/Happstack/Server/Internal/Cookie.hs index 2129ffc..330495a 100644 --- a/src/Happstack/Server/Internal/Cookie.hs +++ b/src/Happstack/Server/Internal/Cookie.hs @@ -4,7 +4,7 @@ module Happstack.Server.Internal.Cookie ( Cookie(..) , CookieLife(..) - , CookieXOriginOption(..) + , SameSite(..) , calcLife , mkCookie , mkCookieHeader @@ -45,7 +45,7 @@ data Cookie = Cookie , cookieValue :: String , secure :: Bool , httpOnly :: Bool - , sameSiteOpts :: CookieXOriginOption + , sameSite :: SameSite } deriving(Show,Eq,Read,Typeable,Data) -- | Specify the lifetime of a cookie. @@ -66,7 +66,7 @@ data CookieLife -- -- Note that most or all web clients require the cookie to be secure if "none" is -- specified. -data CookieXOriginOption +data SameSite = SameSiteLax -- ^ The cookie is sent in first party contexts as well as linked requests initiated -- from other contexts. @@ -77,19 +77,15 @@ data CookieXOriginOption -- secure. | SameSiteNoValue -- ^ The default; used if you do not wish a SameSite attribute present at all. - deriving (Eq, Ord, Typeable, Data) + deriving (Eq, Ord, Typeable, Data, Show, Read) -instance Show CookieXOriginOption where - show SameSiteLax = "Lax" - show SameSiteStrict = "Strict" - show SameSiteNone = "None" - show SameSiteNoValue = "" - -instance Read CookieXOriginOption where - readsPrec _ "Lax" = [(SameSiteLax, "")] - readsPrec _ "Strict" = [(SameSiteStrict, "")] - readsPrec _ "None" = [(SameSiteNone, "")] - readsPrec _ "" = [(SameSiteNoValue, "")] +displaySameSite :: SameSite -> String +displaySameSite ss = + case ss of + SameSiteLax -> "SameSite=Lax" + SameSiteStrict -> "SameSite=Strict" + SameSiteNone -> "SameSite=None" + SameSiteNoValue -> "" -- convert 'CookieLife' to the argument needed for calling 'mkCookieHeader' calcLife :: CookieLife -> IO (Maybe (Int, UTCTime)) @@ -106,7 +102,7 @@ calcLife Expired = -- | Creates a cookie with a default version of 1, empty domain, a -- path of "/", secure == False, httpOnly == False and --- sameSiteOpts == SameSiteNoValue +-- sameSite == SameSiteNoValue -- -- see also: 'addCookie' mkCookie :: String -- ^ cookie name @@ -149,9 +145,8 @@ mkCookieHeader mLife cookie = (cookieName cookie++"="++s cookieValue):[ (k++v) | (k,v) <- l, "" /= v ] ++ (if secure cookie then ["Secure"] else []) ++ (if httpOnly cookie then ["HttpOnly"] else []) - ++ (if sameSiteOpts cookie /= SameSiteNoValue - then ["SameSite=" ++ (show . sameSiteOpts $ cookie)] - else []) + ++ (if sameSite cookie /= SameSiteNoValue + then [displaySameSite . sameSite $ cookie] else []) -- | Not an supported api. Takes a cookie header and returns -- either a String error message or an array of parsed cookies From c403a7663406dff732c8436a8ea612c50bd89db4 Mon Sep 17 00:00:00 2001 From: bugthunk Date: Tue, 15 Sep 2020 10:21:21 +0200 Subject: [PATCH 3/3] Fix test failures... --- CHANGELOG.md | 2 +- happstack-server.cabal | 2 +- tests/Happstack/Server/Tests.hs | 12 ++++++------ 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2df9003..07f1f9e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,4 @@ -7.6.2 +7.7.0 ===== - added support for specifying SameSite attribute diff --git a/happstack-server.cabal b/happstack-server.cabal index 292e74b..c7ec991 100644 --- a/happstack-server.cabal +++ b/happstack-server.cabal @@ -1,5 +1,5 @@ Name: happstack-server -Version: 7.6.2 +Version: 7.7.0 Synopsis: Web related tools and services. Description: Happstack Server provides an HTTP server and a rich set of functions for routing requests, handling query parameters, generating responses, working with cookies, serving files, and more. For in-depth documentation see the Happstack Crash Course License: BSD3 diff --git a/tests/Happstack/Server/Tests.hs b/tests/Happstack/Server/Tests.hs index fc91ea1..5dfc093 100644 --- a/tests/Happstack/Server/Tests.hs +++ b/tests/Happstack/Server/Tests.hs @@ -41,24 +41,24 @@ cookieParserTest = "cookieParserTest" ~: [parseCookies "$Version=1;Cookie1=value1;$Path=\"/testpath\";$Domain=example.com;cookie2=value2" @?= (Right [ - Cookie "1" "/testpath" "example.com" "cookie1" "value1" False False - , Cookie "1" "" "" "cookie2" "value2" False False + Cookie "1" "/testpath" "example.com" "cookie1" "value1" False False SameSiteNoValue + , Cookie "1" "" "" "cookie2" "value2" False False SameSiteNoValue ]) ,parseCookies " \t $Version = \"1\" ; cookie1 = \"randomcrap!@#%^&*()-_+={}[]:;'<>,.?/\\|\" , $Path=/ " @?= (Right [ - Cookie "1" "/" "" "cookie1" "randomcrap!@#%^&*()-_+={}[]:;'<>,.?/|" False False + Cookie "1" "/" "" "cookie1" "randomcrap!@#%^&*()-_+={}[]:;'<>,.?/|" False False SameSiteNoValue ]) ,parseCookies " cookie1 = value1 " @?= (Right [ - Cookie "" "" "" "cookie1" "value1" False False + Cookie "" "" "" "cookie1" "value1" False False SameSiteNoValue ]) ,parseCookies " $Version=\"1\";buggygooglecookie = valuewith=whereitshouldnotbe " @?= (Right [ - Cookie "1" "" "" "buggygooglecookie" "valuewith=whereitshouldnotbe" False False + Cookie "1" "" "" "buggygooglecookie" "valuewith=whereitshouldnotbe" False False SameSiteNoValue ]) , parseCookies "foo=\"\\\"bar\\\"\"" @?= (Right [ - Cookie "" "" "" "foo" "\"bar\"" False False + Cookie "" "" "" "foo" "\"bar\"" False False SameSiteNoValue ]) ]