haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Set content-length whenever evaluating a response body

Browse Source
This commit is contained in:
Michael Snoyman 2014-03-02 14:30:46 +02:00
parent 2819821b2e
commit f4bbe1cc52
2 changed files with 22 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
yesod-core/Yesod/Core/Internal/Response.hs
View File

@ -128,7 +128,9 @@ headerToPair (Header key value) = (CI.mk key, value)
evaluateContent :: Content -> IO (Either ErrorResponse Content) evaluateContent :: Content -> IO (Either ErrorResponse Content)
evaluateContent (ContentBuilder b mlen) = handle f $ do evaluateContent (ContentBuilder b mlen) = handle f $ do
let lbs = toLazyByteString b let lbs = toLazyByteString b
L.length lbs `seq` return (Right $ ContentBuilder (fromLazyByteString lbs) mlen) len = L.length lbs
mlen' = maybe (Just $ fromIntegral len) Just mlen
len `seq` return (Right $ ContentBuilder (fromLazyByteString lbs) mlen')
where where
f :: SomeException -> IO (Either ErrorResponse Content) f :: SomeException -> IO (Either ErrorResponse Content)
f = return . Left . InternalError . T.pack . show f = return . Left . InternalError . T.pack . show

19
yesod-core/test/YesodCoreTest/ErrorHandling.hs
View File

@ -13,6 +13,8 @@ import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
import Control.Exception (SomeException, try) import Control.Exception (SomeException, try)
import Network.HTTP.Types (mkStatus) import Network.HTTP.Types (mkStatus)
import Blaze.ByteString.Builder (Builder, fromByteString, toLazyByteString)
import Data.Monoid (mconcat)
data App = App data App = App
@ -29,6 +31,8 @@ mkYesod "App" [parseRoutes|
/builder BuilderR GET /builder BuilderR GET
/file-bad-len FileBadLenR GET /file-bad-len FileBadLenR GET
/file-bad-name FileBadNameR GET /file-bad-name FileBadNameR GET
/good-builder GoodBuilderR GET
|] |]
overrideStatus = mkStatus 15 "OVERRIDE" overrideStatus = mkStatus 15 "OVERRIDE"
@ -88,6 +92,12 @@ getFileBadLenR = return $ TypedContent "ignored" $ ContentFile "yesod-core.cabal
getFileBadNameR :: Handler TypedContent getFileBadNameR :: Handler TypedContent
getFileBadNameR = return $ TypedContent "ignored" $ ContentFile (error "filebadname") Nothing getFileBadNameR = return $ TypedContent "ignored" $ ContentFile (error "filebadname") Nothing
goodBuilderContent :: Builder
goodBuilderContent = mconcat $ replicate 100 $ fromByteString "This is a test\n"
getGoodBuilderR :: Handler TypedContent
getGoodBuilderR = return $ TypedContent "text/plain" $ toContent goodBuilderContent
errorHandlingTest :: Spec errorHandlingTest :: Spec
errorHandlingTest = describe "Test.ErrorHandling" $ do errorHandlingTest = describe "Test.ErrorHandling" $ do
it "says not found" caseNotFound it "says not found" caseNotFound
@ -99,6 +109,7 @@ errorHandlingTest = describe "Test.ErrorHandling" $ do
it "builder" caseBuilder it "builder" caseBuilder
it "file with bad len" caseFileBadLen it "file with bad len" caseFileBadLen
it "file with bad name" caseFileBadName it "file with bad name" caseFileBadName
it "builder includes content-length" caseGoodBuilder
runner :: Session () -> IO () runner :: Session () -> IO ()
runner f = toWaiApp App >>= runSession f runner f = toWaiApp App >>= runSession f
@ -175,3 +186,11 @@ caseFileBadName = runner $ do
res <- request defaultRequest { pathInfo = ["file-bad-name"] } res <- request defaultRequest { pathInfo = ["file-bad-name"] }
assertStatus 500 res assertStatus 500 res
assertBodyContains "filebadname" res assertBodyContains "filebadname" res
caseGoodBuilder :: IO ()
caseGoodBuilder = runner $ do
res <- request defaultRequest { pathInfo = ["good-builder"] }
assertStatus 200 res
let lbs = toLazyByteString goodBuilderContent
assertBody lbs res
assertHeader "content-length" (S8.pack $ show $ L.length lbs) res