Bugfix regarding HEAD requests

[Lucu.git] / Network / HTTP / Lucu / Interaction.hs

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index d36c4d1773d4ebcaad2cf2937d5ce0fcddf716b0..7c43f96c5e7a12bcf3145771a7ea6b4976fed17e 100644 (file)
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -111,7 +111,6 @@ data SemanticallyInvalidInteraction
 
       , seiResponse         ∷ !Response
       , seiWillChunkBody    ∷ !Bool
-      , seiWillDiscardBody  ∷ !Bool
       , seiWillClose        ∷ !Bool
       , seiBodyToSend       ∷ !Builder
       }
@@ -143,7 +142,6 @@ mkSemanticallyInvalidInteraction config@(Config {..}) (AugmentedRequest {..})
 
                 , seiResponse         = res
                 , seiWillChunkBody    = arWillChunkBody
-                , seiWillDiscardBody  = arWillDiscardBody
                 , seiWillClose        = arWillClose
                 , seiBodyToSend       = body
                 }
@@ -168,7 +166,6 @@ data NormalInteraction
       , niResponse         ∷ !(TVar Response)
       , niSendContinue     ∷ !(TMVar Bool)
       , niWillChunkBody    ∷ !Bool
-      , niWillDiscardBody  ∷ !(TVar Bool)
       , niWillClose        ∷ !(TVar Bool)
       , niResponseHasCType ∷ !(TVar Bool)
       -- FIXME: use TBChan Builder (in stm-chans package)
@@ -212,7 +209,6 @@ mkNormalInteraction config remoteAddr (AugmentedRequest {..}) rsrcPath
 
          response         ← newTVarIO $ emptyResponse arInitialStatus
          sendContinue     ← newEmptyTMVarIO
-         willDiscardBody  ← newTVarIO arWillDiscardBody
          willClose        ← newTVarIO arWillClose
          responseHasCType ← newTVarIO False
          bodyToSend       ← newEmptyTMVarIO
@@ -236,7 +232,6 @@ mkNormalInteraction config remoteAddr (AugmentedRequest {..}) rsrcPath
                 , niResponse         = response
                 , niSendContinue     = sendContinue
                 , niWillChunkBody    = arWillChunkBody
-                , niWillDiscardBody  = willDiscardBody
                 , niWillClose        = willClose
                 , niResponseHasCType = responseHasCType
                 , niBodyToSend       = bodyToSend