yesod-core 1.4.36 → 1.4.37
raw patch · 4 files changed
+83/−13 lines, 4 files
Files
- ChangeLog.md +4/−0
- Yesod/Core/Handler.hs +53/−9
- test/YesodCoreTest/Redirect.hs +25/−3
- yesod-core.cabal +1/−1
ChangeLog.md view
@@ -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)
Yesod/Core/Handler.hs view
@@ -123,6 +123,7 @@ , alreadyExpired , expiresAt , setEtag+ , setWeakEtag -- * Session , SessionMap , lookupSession@@ -851,12 +852,24 @@ 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,53 @@ setEtag etag = do mmatch <- lookupHeader "if-none-match" let matches = maybe [] parseMatch mmatch- if 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. 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. --
test/YesodCoreTest/Redirect.hs view
@@ -6,7 +6,7 @@ ) 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 @@ /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 @@ 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@@ -77,6 +79,8 @@ 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"]@@ -102,9 +106,27 @@ , 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
yesod-core.cabal view
@@ -1,5 +1,5 @@ name: yesod-core-version: 1.4.36+version: 1.4.37 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>