X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FPreprocess.hs;h=1915b1bd44e3a93f95ffba41f922d3f2bea0bc94;hp=1284f2b322749e2e69dcd0d69702065a7aa99644;hb=246d66d6d3130e03834a6c3badc38711a1879aae;hpb=24d6b6e25e79495eaa00eb6eacdb707d181d0770 diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs index 1284f2b..1915b1b 100644 --- a/Network/HTTP/Lucu/Preprocess.hs +++ b/Network/HTTP/Lucu/Preprocess.hs @@ -18,9 +18,10 @@ import qualified Data.Ascii as A 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 @@ -35,7 +36,6 @@ data AugmentedRequest arRequest ∷ !Request , arInitialStatus ∷ !SomeStatusCode , arWillChunkBody ∷ !Bool - , arWillDiscardBody ∷ !Bool , arWillClose ∷ !Bool , arExpectedContinue ∷ !Bool , arReqBodyLength ∷ !(Maybe RequestBodyLength) @@ -55,7 +55,6 @@ preprocess localHost localPort req@(Request {..}) arRequest = req , arInitialStatus = fromStatusCode OK , arWillChunkBody = False - , arWillDiscardBody = False , arWillClose = False , arExpectedContinue = False , arReqBodyLength = Nothing @@ -100,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 () @@ -137,7 +136,7 @@ examineAuthority localHost localPort parseHost ∷ Ascii → (CI Text, Ascii) parseHost hp - = let (h, p) = C8.break (≡ ':') $ A.toByteString hp + = let (h, p) = C8.break (≡ ':') $ cs hp -- FIXME: should decode punycode here. hText = CI.mk $ T.decodeUtf8 h pAscii = A.unsafeFromByteString p @@ -150,8 +149,8 @@ updateAuthority host port req uri' = uri { uriAuthority = Just URIAuth { uriUserInfo = "" - , uriRegName = T.unpack $ CI.original host - , uriPort = A.toString port + , uriRegName = cs $ CI.original host + , uriPort = cs port } } in @@ -179,7 +178,7 @@ examineHeaders | otherwise → setStatus NotImplemented - case A.toByteString <$> getHeader "Content-Length" req of + case cs <$> getHeader "Content-Length" req of Nothing → return () Just value → case C8.readInt value of Just (len, garbage)