Bugfix regarding HEAD requests

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

diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs
index 77047273c43564feddc2ef688be16eb652f57d73..1915b1bd44e3a93f95ffba41f922d3f2bea0bc94 100644 (file)
--- a/Network/HTTP/Lucu/Preprocess.hs
+++ b/Network/HTTP/Lucu/Preprocess.hs
@@ -19,9 +19,9 @@ import qualified Data.ByteString.Char8 as C8
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 import Data.Convertible.Base
+import Data.Convertible.Instances.Text ()
 import Data.Maybe
 import Data.Text (Text)
-import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.HttpVersion
@@ -36,7 +36,6 @@ data AugmentedRequest
         arRequest          ∷ !Request
       , arInitialStatus    ∷ !SomeStatusCode
       , arWillChunkBody    ∷ !Bool
-      , arWillDiscardBody  ∷ !Bool
       , arWillClose        ∷ !Bool
       , arExpectedContinue ∷ !Bool
       , arReqBodyLength    ∷ !(Maybe RequestBodyLength)
@@ -56,7 +55,6 @@ preprocess localHost localPort req@(Request {..})
                     arRequest          = req
                   , arInitialStatus    = fromStatusCode OK
                   , arWillChunkBody    = False
-                  , arWillDiscardBody  = False
                   , arWillClose        = False
                   , arExpectedContinue = False
                   , arReqBodyLength    = Nothing
@@ -101,7 +99,7 @@ examineMethod
     = do req ← gets arRequest
          case reqMethod req of
            GET    → return ()
-           HEAD   → modify $ \ar → ar { arWillDiscardBody = True }
+           HEAD   → return ()
            POST   → return ()
            PUT    → return ()
            DELETE → return ()
@@ -151,7 +149,7 @@ updateAuthority host port req
           uri' = uri {
                    uriAuthority = Just URIAuth {
                                     uriUserInfo = ""
-                                  , uriRegName  = T.unpack $ CI.original host
+                                  , uriRegName  = cs $ CI.original host
                                   , uriPort     = cs port
                                   }
                  }