diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ +## 3.3.9 + +* Don't insert Last-Modified: if exists. + [#791](https://github.com/yesodweb/wai/pull/791) + ## 3.3.8 * Maximum header size is configurable. diff --git a/Network/Wai/Handler/Warp/File.hs b/Network/Wai/Handler/Warp/File.hs --- a/Network/Wai/Handler/Warp/File.hs +++ b/Network/Wai/Handler/Warp/File.hs @@ -34,12 +34,15 @@ ---------------------------------------------------------------- conditionalRequest :: I.FileInfo - -> H.ResponseHeaders -> IndexedHeader + -> H.ResponseHeaders + -> IndexedHeader -- ^ Response + -> IndexedHeader -- ^ Request -> RspFileInfo -conditionalRequest finfo hs0 reqidx = case condition of +conditionalRequest finfo hs0 rspidx reqidx = case condition of nobody@(WithoutBody _) -> nobody - WithBody s _ off len -> let !hs = (H.hLastModified,date) : - addContentHeaders hs0 off len size + WithBody s _ off len -> let !hs1 = addContentHeaders hs0 off len size + !hasLM = isJust $ rspidx ! fromEnum ResLastModified + !hs = [ (H.hLastModified,date) | not hasLM ] ++ hs1 in WithBody s hs off len where !mtime = I.fileInfoTime finfo diff --git a/Network/Wai/Handler/Warp/HTTP2/Response.hs b/Network/Wai/Handler/Warp/HTTP2/Response.hs --- a/Network/Wai/Handler/Warp/HTTP2/Response.hs +++ b/Network/Wai/Handler/Warp/HTTP2/Response.hs @@ -72,7 +72,8 @@ Left (_ex :: E.IOException) -> return $ response404 rsphdr Right finfo -> do let reqidx = indexRequestHeader reqhdr - case conditionalRequest finfo rsphdr reqidx of + rspidx = indexResponseHeader rsphdr + case conditionalRequest finfo rsphdr rspidx reqidx of WithoutBody s -> return $ responseNoBody s rsphdr WithBody s rsphdr' off bytes -> do let !off' = fromIntegral off diff --git a/Network/Wai/Handler/Warp/Header.hs b/Network/Wai/Handler/Warp/Header.hs --- a/Network/Wai/Handler/Warp/Header.hs +++ b/Network/Wai/Handler/Warp/Header.hs @@ -69,6 +69,7 @@ data ResponseHeaderIndex = ResContentLength | ResServer | ResDate + | ResLastModified deriving (Enum,Bounded) -- | The size for 'IndexedHeader' for HTTP Response. @@ -79,6 +80,7 @@ responseKeyIndex hn = case BS.length bs of 4 -> if bs == "date" then fromEnum ResDate else -1 6 -> if bs == "server" then fromEnum ResServer else -1 + 13 -> if bs == "last-modified" then fromEnum ResLastModified else -1 14 -> if bs == "content-length" then fromEnum ResContentLength else -1 _ -> -1 where diff --git a/Network/Wai/Handler/Warp/Response.hs b/Network/Wai/Handler/Warp/Response.hs --- a/Network/Wai/Handler/Warp/Response.hs +++ b/Network/Wai/Handler/Warp/Response.hs @@ -116,14 +116,14 @@ -- and status, the response to HEAD is processed here. -- -- See definition of rsp below for proper body stripping. - (ms, mlen) <- sendRsp conn ii ver s hs rsp + (ms, mlen) <- sendRsp conn ii ver s hs rspidxhdr rsp case ms of Nothing -> return () Just realStatus -> logger req realStatus mlen T.tickle th return ret else do - _ <- sendRsp conn ii ver s hs RspNoBody + _ <- sendRsp conn ii ver s hs rspidxhdr RspNoBody logger req s Nothing T.tickle th return isPersist @@ -196,12 +196,13 @@ -> H.HttpVersion -> H.Status -> H.ResponseHeaders + -> IndexedHeader -- Response -> Rsp -> IO (Maybe H.Status, Maybe Integer) ---------------------------------------------------------------- -sendRsp conn _ ver s hs RspNoBody = do +sendRsp conn _ ver s hs _ RspNoBody = do -- Not adding Content-Length. -- User agents treats it as Content-Length: 0. composeHeader ver s hs >>= connSendAll conn @@ -209,7 +210,7 @@ ---------------------------------------------------------------- -sendRsp conn _ ver s hs (RspBuilder body needsChunked) = do +sendRsp conn _ ver s hs _ (RspBuilder body needsChunked) = do header <- composeHeaderBuilder ver s hs needsChunked let hdrBdy | needsChunked = header <> chunkedTransferEncoding body @@ -222,7 +223,7 @@ ---------------------------------------------------------------- -sendRsp conn _ ver s hs (RspStream streamingBody needsChunked th) = do +sendRsp conn _ ver s hs _ (RspStream streamingBody needsChunked th) = do header <- composeHeaderBuilder ver s hs needsChunked (recv, finish) <- newByteStringBuilderRecv $ reuseBufferStrategy $ toBuilderBuffer (connWriteBuffer conn) (connBufferSize conn) @@ -246,7 +247,7 @@ ---------------------------------------------------------------- -sendRsp conn _ _ _ _ (RspRaw withApp src tickle) = do +sendRsp conn _ _ _ _ _ (RspRaw withApp src tickle) = do withApp recv send return (Nothing, Nothing) where @@ -260,8 +261,8 @@ -- Sophisticated WAI applications. -- We respect s0. s0 MUST be a proper value. -sendRsp conn ii ver s0 hs0 (RspFile path (Just part) _ isHead hook) = - sendRspFile2XX conn ii ver s0 hs path beg len isHead hook +sendRsp conn ii ver s0 hs0 rspidxhdr (RspFile path (Just part) _ isHead hook) = + sendRspFile2XX conn ii ver s0 hs rspidxhdr path beg len isHead hook where beg = filePartOffset part len = filePartByteCount part @@ -271,17 +272,17 @@ -- Simple WAI applications. -- Status is ignored -sendRsp conn ii ver _ hs0 (RspFile path Nothing idxhdr isHead hook) = do +sendRsp conn ii ver _ hs0 rspidxhdr (RspFile path Nothing reqidxhdr isHead hook) = do efinfo <- E.try $ getFileInfo ii path case efinfo of Left (_ex :: E.IOException) -> #ifdef WARP_DEBUG print _ex >> #endif - sendRspFile404 conn ii ver hs0 - Right finfo -> case conditionalRequest finfo hs0 idxhdr of - WithoutBody s -> sendRsp conn ii ver s hs0 RspNoBody - WithBody s hs beg len -> sendRspFile2XX conn ii ver s hs path beg len isHead hook + sendRspFile404 conn ii ver hs0 rspidxhdr + Right finfo -> case conditionalRequest finfo hs0 rspidxhdr reqidxhdr of + WithoutBody s -> sendRsp conn ii ver s hs0 rspidxhdr RspNoBody + WithBody s hs beg len -> sendRspFile2XX conn ii ver s hs rspidxhdr path beg len isHead hook ---------------------------------------------------------------- @@ -290,14 +291,15 @@ -> H.HttpVersion -> H.Status -> H.ResponseHeaders + -> IndexedHeader -> FilePath -> Integer -> Integer -> Bool -> IO () -> IO (Maybe H.Status, Maybe Integer) -sendRspFile2XX conn ii ver s hs path beg len isHead hook - | isHead = sendRsp conn ii ver s hs RspNoBody +sendRspFile2XX conn ii ver s hs rspidxhdr path beg len isHead hook + | isHead = sendRsp conn ii ver s hs rspidxhdr RspNoBody | otherwise = do lheader <- composeHeader ver s hs (mfd, fresher) <- getFd ii path @@ -310,8 +312,9 @@ -> InternalInfo -> H.HttpVersion -> H.ResponseHeaders + -> IndexedHeader -> IO (Maybe H.Status, Maybe Integer) -sendRspFile404 conn ii ver hs0 = sendRsp conn ii ver s hs (RspBuilder body True) +sendRspFile404 conn ii ver hs0 rspidxhdr = sendRsp conn ii ver s hs rspidxhdr (RspBuilder body True) where s = H.notFound404 hs = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0 diff --git a/test/FileSpec.hs b/test/FileSpec.hs --- a/test/FileSpec.hs +++ b/test/FileSpec.hs @@ -21,7 +21,7 @@ let WithBody s hs off len = ans hs' = ("Last-Modified",fileInfoDate finfo) : hs ans' = WithBody s hs' off len - conditionalRequest finfo [] (indexRequestHeader reqhs) `shouldBe` ans' + conditionalRequest finfo [] (indexResponseHeader hs) (indexRequestHeader reqhs) `shouldBe` ans' spec :: Spec spec = do diff --git a/warp.cabal b/warp.cabal --- a/warp.cabal +++ b/warp.cabal @@ -1,5 +1,5 @@ Name: warp -Version: 3.3.8 +Version: 3.3.9 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE