X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FPostprocess.hs;fp=Network%2FHTTP%2FLucu%2FPostprocess.hs;h=7157b7d56e9dd14c4dcaa635ce47be599d2d15f6;hp=4ba7865d466f499a11d6a5f86c133bfc34b705f4;hb=246d66d6d3130e03834a6c3badc38711a1879aae;hpb=1de2506621977a383b991cadce024f626023908b diff --git a/Network/HTTP/Lucu/Postprocess.hs b/Network/HTTP/Lucu/Postprocess.hs index 4ba7865..7157b7d 100644 --- a/Network/HTTP/Lucu/Postprocess.hs +++ b/Network/HTTP/Lucu/Postprocess.hs @@ -69,29 +69,24 @@ abortOnCertainConditions (NI {..}) postprocessWithRequest ∷ NormalInteraction → STM () postprocessWithRequest ni@(NI {..}) - = do willDiscardBody ← readTVar niWillDiscardBody - canHaveBody ← if willDiscardBody then - return False - else - resCanHaveBody <$> readTVar niResponse - - updateRes ni + = do updateRes ni $ deleteHeader "Content-Length" ∘ deleteHeader "Transfer-Encoding" + canHaveBody ← resCanHaveBody <$> readTVar niResponse if canHaveBody then - do when niWillChunkBody $ - writeHeader ni "Transfer-Encoding" (Just "chunked") - writeDefaultPageIfNeeded ni - else - do writeTVar niWillDiscardBody True - -- These headers make sense for HEAD requests even - -- when there won't be a response entity body. + do when niWillChunkBody + $ writeHeader ni "Transfer-Encoding" (Just "chunked") when (reqMethod niRequest ≢ HEAD) - $ updateRes ni - $ deleteHeader "Content-Type" - ∘ deleteHeader "Etag" - ∘ deleteHeader "Last-Modified" + $ writeDefaultPageIfNeeded ni + else + -- These headers make sense for HEAD requests even when + -- there won't be a response entity body. + when (reqMethod niRequest ≢ HEAD) + $ updateRes ni + $ deleteHeader "Content-Type" + ∘ deleteHeader "Etag" + ∘ deleteHeader "Last-Modified" hasConnClose ← (≡ Just "close") <$> readCIHeader ni "Connection" willClose ← readTVar niWillClose