From fd872cff40d02bd0e12b85581e59907377dbdf34 Mon Sep 17 00:00:00 2001 From: Ian Duncan Date: Wed, 6 Sep 2017 10:08:45 +0900 Subject: [PATCH 1/2] Add support to yesod-core for weak etags --- yesod-core/ChangeLog.md | 4 ++ yesod-core/Yesod/Core/Handler.hs | 58 +++++++++++++++++++---- yesod-core/test/YesodCoreTest/Redirect.hs | 28 +++++++++-- yesod-core/yesod-core.cabal | 2 +- 4 files changed, 78 insertions(+), 14 deletions(-) diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index 9f946793..6e9d8d3e 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.4.37 + +* Add `setWeakEtag` function in Yesod.Core.Handler module. + ## 1.4.36 * Add `replaceOrAddHeader` function in Yesod.Core.Handler module. [1416](https://github.com/yesodweb/yesod/issues/1416) diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index 3b1b50ed..aaf7de3a 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -123,6 +123,7 @@ module Yesod.Core.Handler , alreadyExpired , expiresAt , setEtag + , setWeakEtag -- * Session , SessionMap , lookupSession @@ -851,12 +852,24 @@ alreadyExpired = setHeader "Expires" "Thu, 01 Jan 1970 05:05:05 GMT" expiresAt :: MonadHandler m => UTCTime -> m () expiresAt = setHeader "Expires" . formatRFC1123 +data Etag + = WeakEtag !S.ByteString + -- ^ Prefixed by W/ and surrounded in quotes. Signifies that contents are + -- semantically identical but make no guarantees about being bytewise identical. + | StrongEtag !S.ByteString + -- ^ Signifies that contents should be byte-for-byte identical if they match + -- the provided ETag + | InvalidEtag !S.ByteString + -- ^ Anything else that ends up in a header that expects an ETag but doesn't + -- properly follow the ETag format specified in RFC 7232, section 2.3 + deriving (Show, Eq) + -- | Check the if-none-match header and, if it matches the given value, return -- a 304 not modified response. Otherwise, set the etag header to the given -- value. -- -- Note that it is the responsibility of the caller to ensure that the provided --- value is a value etag value, no sanity checking is performed by this +-- value is a valid etag value, no sanity checking is performed by this -- function. -- -- @since 1.4.4 @@ -864,22 +877,49 @@ setEtag :: MonadHandler m => Text -> m () setEtag etag = do mmatch <- lookupHeader "if-none-match" let matches = maybe [] parseMatch mmatch - if encodeUtf8 etag `elem` matches + if StrongEtag (encodeUtf8 etag) `elem` matches then notModified else addHeader "etag" $ T.concat ["\"", etag, "\""] --- | Parse an if-none-match field according to the spec. Does not parsing on --- weak matches, which are not supported by setEtag. -parseMatch :: S.ByteString -> [S.ByteString] +-- | Parse an if-none-match field according to the spec. +parseMatch :: S.ByteString -> [Etag] parseMatch = map clean . S.split W8._comma where - clean = stripQuotes . fst . S.spanEnd W8.isSpace . S.dropWhile W8.isSpace + clean = classify . fst . S.spanEnd W8.isSpace . S.dropWhile W8.isSpace - stripQuotes bs + classify bs | S.length bs >= 2 && S.head bs == W8._quotedbl && S.last bs == W8._quotedbl - = S.init $ S.tail bs - | otherwise = bs + = StrongEtag $ S.init $ S.tail bs + | S.length bs >= 4 && + S.head bs == W8._W && + S.index bs 1 == W8._slash && + S.index bs 2 == W8._quotedbl && + S.last bs == W8._quotedbl + = WeakEtag $ S.init $ S.drop 3 bs + | otherwise = InvalidEtag bs + +-- | Check the if-none-match header and, if it matches the given value, return +-- a 304 not modified response. Otherwise, set the etag header to the given +-- value. +-- +-- A weak etag is only expected to be semantically identical to the prior content, +-- but doesn't have to be byte-for-byte identical. Therefore it can be useful for +-- dynamically generated content that may be difficult to perform bytewise hashing +-- upon. +-- +-- Note that it is the responsibility of the caller to ensure that the provided +-- value is a valid etag value, no sanity checking is performed by this +-- function. +-- +-- @since 1.4.37 +setWeakEtag :: MonadHandler m => Text -> m () +setWeakEtag etag = do + mmatch <- lookupHeader "if-none-match" + let matches = maybe [] parseMatch mmatch + if WeakEtag (encodeUtf8 etag) `elem` matches + then notModified + else addHeader "etag" $ T.concat ["W/\"", etag, "\""] -- | Set a variable in the user's session. -- diff --git a/yesod-core/test/YesodCoreTest/Redirect.hs b/yesod-core/test/YesodCoreTest/Redirect.hs index d4e63932..b916d784 100644 --- a/yesod-core/test/YesodCoreTest/Redirect.hs +++ b/yesod-core/test/YesodCoreTest/Redirect.hs @@ -6,7 +6,7 @@ module YesodCoreTest.Redirect ) where import YesodCoreTest.YesodTest -import Yesod.Core.Handler (redirectWith, setEtag) +import Yesod.Core.Handler (redirectWith, setEtag, setWeakEtag) import qualified Network.HTTP.Types as H data Y = Y @@ -17,6 +17,7 @@ mkYesod "Y" [parseRoutes| /r307 R307 GET /rregular RRegular GET /etag EtagR GET +/weak-etag WeakEtagR GET |] instance Yesod Y where approot = ApprootStatic "http://test" app :: Session () -> IO () @@ -28,12 +29,13 @@ getRootR = return () postRootR :: Handler () postRootR = return () -getR301, getR303, getR307, getRRegular, getEtagR :: Handler () +getR301, getR303, getR307, getRRegular, getEtagR, getWeakEtagR :: Handler () getR301 = redirectWith H.status301 RootR getR303 = redirectWith H.status303 RootR getR307 = redirectWith H.status307 RootR getRRegular = redirect RootR getEtagR = setEtag "hello world" +getWeakEtagR = setWeakEtag "hello world" specs :: Spec specs = describe "Redirect" $ do @@ -82,7 +84,7 @@ specs = describe "Redirect" $ do { pathInfo = ["etag"] , requestHeaders = [("if-none-match", "hello world")] } - assertStatus 304 res + assertStatus 200 res it "different if-none-match" $ app $ do res <- request defaultRequest { pathInfo = ["etag"] @@ -102,9 +104,27 @@ specs = describe "Redirect" $ do , requestHeaders = [("if-none-match", "\"foo\", \"hello world\"")] } assertStatus 304 res - it "ignore weak" $ app $ do + it "ignore weak when provided normal etag" $ app $ do res <- request defaultRequest { pathInfo = ["etag"] , requestHeaders = [("if-none-match", "\"foo\", W/\"hello world\"")] } assertStatus 200 res + it "weak etag" $ app $ do + res <- request defaultRequest + { pathInfo = ["weak-etag"] + , requestHeaders = [("if-none-match", "\"foo\", W/\"hello world\"")] + } + assertStatus 304 res + it "different if-none-match for weak etag" $ app $ do + res <- request defaultRequest + { pathInfo = ["weak-etag"] + , requestHeaders = [("if-none-match", "W/\"foo\"")] + } + assertStatus 200 res + it "ignore strong when expecting weak" $ app $ do + res <- request defaultRequest + { pathInfo = ["weak-etag"] + , requestHeaders = [("if-none-match", "\"hello world\", W/\"foo\"")] + } + assertStatus 200 res diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index e5c8bba2..80794eb3 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.4.36 +version: 1.4.37 license: MIT license-file: LICENSE author: Michael Snoyman From 05b2193e9fa49c429df62c2661af0086396660ef Mon Sep 17 00:00:00 2001 From: Ian Duncan Date: Fri, 8 Sep 2017 09:00:12 +0900 Subject: [PATCH 2/2] Code review fixes for #1444 --- yesod-core/Yesod/Core/Handler.hs | 6 +++++- yesod-core/test/YesodCoreTest/Redirect.hs | 4 +++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index aaf7de3a..94dd27dc 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -877,10 +877,14 @@ setEtag :: MonadHandler m => Text -> m () setEtag etag = do mmatch <- lookupHeader "if-none-match" let matches = maybe [] parseMatch mmatch - if StrongEtag (encodeUtf8 etag) `elem` matches + baseTag = encodeUtf8 etag + strongTag = StrongEtag baseTag + badTag = InvalidEtag baseTag + if any (\tag -> tag == strongTag || tag == badTag) matches then notModified else addHeader "etag" $ T.concat ["\"", etag, "\""] + -- | Parse an if-none-match field according to the spec. parseMatch :: S.ByteString -> [Etag] parseMatch = diff --git a/yesod-core/test/YesodCoreTest/Redirect.hs b/yesod-core/test/YesodCoreTest/Redirect.hs index b916d784..c922113a 100644 --- a/yesod-core/test/YesodCoreTest/Redirect.hs +++ b/yesod-core/test/YesodCoreTest/Redirect.hs @@ -79,12 +79,14 @@ specs = describe "Redirect" $ do res <- request defaultRequest { pathInfo = ["etag"] } assertStatus 200 res assertHeader "etag" "\"hello world\"" res + -- Note: this violates the RFC around ETag format, but is being left as is + -- out of concerns that it might break existing users with misbehaving clients. it "single, unquoted if-none-match" $ app $ do res <- request defaultRequest { pathInfo = ["etag"] , requestHeaders = [("if-none-match", "hello world")] } - assertStatus 200 res + assertStatus 304 res it "different if-none-match" $ app $ do res <- request defaultRequest { pathInfo = ["etag"]