Set content-length whenever evaluating a response body

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

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