diff --git a/yesod-core/Yesod/Core/Internal/Response.hs b/yesod-core/Yesod/Core/Internal/Response.hs index fce9e2e7..73fe107d 100644 --- a/yesod-core/Yesod/Core/Internal/Response.hs +++ b/yesod-core/Yesod/Core/Internal/Response.hs @@ -128,7 +128,9 @@ headerToPair (Header key value) = (CI.mk key, value) evaluateContent :: Content -> IO (Either ErrorResponse Content) evaluateContent (ContentBuilder b mlen) = handle f $ do 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 f :: SomeException -> IO (Either ErrorResponse Content) f = return . Left . InternalError . T.pack . show diff --git a/yesod-core/test/YesodCoreTest/ErrorHandling.hs b/yesod-core/test/YesodCoreTest/ErrorHandling.hs index 333d2b89..0bb294fb 100644 --- a/yesod-core/test/YesodCoreTest/ErrorHandling.hs +++ b/yesod-core/test/YesodCoreTest/ErrorHandling.hs @@ -13,6 +13,8 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Char8 as S8 import Control.Exception (SomeException, try) import Network.HTTP.Types (mkStatus) +import Blaze.ByteString.Builder (Builder, fromByteString, toLazyByteString) +import Data.Monoid (mconcat) data App = App @@ -29,6 +31,8 @@ mkYesod "App" [parseRoutes| /builder BuilderR GET /file-bad-len FileBadLenR GET /file-bad-name FileBadNameR GET + +/good-builder GoodBuilderR GET |] overrideStatus = mkStatus 15 "OVERRIDE" @@ -88,6 +92,12 @@ getFileBadLenR = return $ TypedContent "ignored" $ ContentFile "yesod-core.cabal getFileBadNameR :: Handler TypedContent 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 = describe "Test.ErrorHandling" $ do it "says not found" caseNotFound @@ -99,6 +109,7 @@ errorHandlingTest = describe "Test.ErrorHandling" $ do it "builder" caseBuilder it "file with bad len" caseFileBadLen it "file with bad name" caseFileBadName + it "builder includes content-length" caseGoodBuilder runner :: Session () -> IO () runner f = toWaiApp App >>= runSession f @@ -175,3 +186,11 @@ caseFileBadName = runner $ do res <- request defaultRequest { pathInfo = ["file-bad-name"] } assertStatus 500 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