X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResponseWriter.hs;h=39e4e50f3a7831dab7ca935164b85492fd07eec3;hb=243b99439640480fc148d2e175247dacce04a222;hp=15f3d6884064715c1281f9f0c42fe12bdca6bc78;hpb=5f2ef377345fc47aabc63c1325df82c1cd9da9ed;p=Lucu.git

diff --git a/Network/HTTP/Lucu/ResponseWriter.hs b/Network/HTTP/Lucu/ResponseWriter.hs
index 15f3d68..39e4e50 100644
--- a/Network/HTTP/Lucu/ResponseWriter.hs
+++ b/Network/HTTP/Lucu/ResponseWriter.hs
@@ -24,7 +24,9 @@ import Network.HTTP.Lucu.Config
 import Network.HTTP.Lucu.HandleLike
 import Network.HTTP.Lucu.HttpVersion
 import Network.HTTP.Lucu.Interaction
+import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 import Prelude.Unicode
 import System.IO (hPutStrLn, stderr)
 
@@ -129,14 +131,14 @@ writeBodyIfNeeded ∷ HandleLike h
 writeBodyIfNeeded ctx ni@(NI {..})
     = join $
       atomically $
-      do willDiscardBody ← readTVar niWillDiscardBody
-         if willDiscardBody then
-             return $ discardBody ctx ni
-         else
+      do canHaveBody ← resCanHaveBody <$> readTVar niResponse
+         if canHaveBody ∧ reqMethod niRequest ≢ HEAD then
              if niWillChunkBody then
                  return $ writeChunkedBody    ctx ni
              else
                  return $ writeNonChunkedBody ctx ni
+         else
+             return $ discardBody ctx ni
 
 discardBody ∷ HandleLike h
             ⇒ Context h
@@ -233,7 +235,7 @@ writeResponseForSEI ∷ HandleLike h
                     → IO ()
 writeResponseForSEI ctx@(Context {..}) (SEI {..})
     = do hPutBuilder cHandle $ convertSuccessVia ((⊥) ∷ AsciiBuilder) seiResponse
-         unless seiWillDiscardBody $
+         when (reqMethod seiRequest ≢ HEAD) $
              if seiWillChunkBody then
                  do hPutBuilder cHandle $ BB.chunkedTransferEncoding seiBodyToSend
                     hPutBuilder cHandle BB.chunkedTransferTerminator