X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FPreprocess.hs;h=77047273c43564feddc2ef688be16eb652f57d73;hp=26fbd53546a2412a90d40f5f30c234620ab6890d;hb=6680828c79aff38431704075c339e043b577589e;hpb=3eb69879d3b336c7c3e613c0ce4bfb3c67989ff3 diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs index 26fbd53..7704727 100644 --- a/Network/HTTP/Lucu/Preprocess.hs +++ b/Network/HTTP/Lucu/Preprocess.hs @@ -16,6 +16,9 @@ import Control.Monad.State.Strict import Data.Ascii (Ascii) 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.Maybe import Data.Text (Text) import qualified Data.Text as T @@ -31,7 +34,7 @@ import Prelude.Unicode data AugmentedRequest = AugmentedRequest { arRequest ∷ !Request - , arInitialStatus ∷ !StatusCode + , arInitialStatus ∷ !SomeStatusCode , arWillChunkBody ∷ !Bool , arWillDiscardBody ∷ !Bool , arWillClose ∷ !Bool @@ -44,14 +47,14 @@ data RequestBodyLength | Chunked deriving (Eq, Show) -preprocess ∷ Text → PortNumber → Request → AugmentedRequest +preprocess ∷ CI Text → PortNumber → Request → AugmentedRequest preprocess localHost localPort req@(Request {..}) = execState go initialAR where initialAR ∷ AugmentedRequest initialAR = AugmentedRequest { arRequest = req - , arInitialStatus = Ok + , arInitialStatus = fromStatusCode OK , arWillChunkBody = False , arWillDiscardBody = False , arWillClose = False @@ -69,9 +72,9 @@ setRequest ∷ Request → State AugmentedRequest () setRequest req = modify $ \ar → ar { arRequest = req } -setStatus ∷ StatusCode → State AugmentedRequest () +setStatus ∷ StatusCode sc ⇒ sc → State AugmentedRequest () setStatus sc - = modify $ \ar → ar { arInitialStatus = sc } + = modify $ \ar → ar { arInitialStatus = fromStatusCode sc } setWillClose ∷ Bool → State AugmentedRequest () setWillClose b @@ -90,7 +93,7 @@ examineHttpVersion → setWillClose True HttpVersion 1 1 → modify $ \ar → ar { arWillChunkBody = True } - _ → do setStatus HttpVersionNotSupported + _ → do setStatus HTTPVersionNotSupported setWillClose True examineMethod ∷ State AugmentedRequest () @@ -104,7 +107,7 @@ examineMethod DELETE → return () _ → setStatus NotImplemented -examineAuthority ∷ Text → PortNumber → State AugmentedRequest () +examineAuthority ∷ CI Text → PortNumber → State AugmentedRequest () examineAuthority localHost localPort = do req ← gets arRequest when (isNothing $ uriAuthority $ reqURI req) $ @@ -133,23 +136,23 @@ examineAuthority localHost localPort -- Should never reach here... ver → fail ("internal error: unknown version: " ⧺ show ver) -parseHost ∷ Ascii → (Text, Ascii) +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 = T.decodeUtf8 h + hText = CI.mk $ T.decodeUtf8 h pAscii = A.unsafeFromByteString p in (hText, pAscii) -updateAuthority ∷ Text → Ascii → Request → Request +updateAuthority ∷ CI Text → Ascii → Request → Request updateAuthority host port req = let uri = reqURI req uri' = uri { uriAuthority = Just URIAuth { uriUserInfo = "" - , uriRegName = T.unpack host - , uriPort = A.toString port + , uriRegName = T.unpack $ CI.original host + , uriPort = cs port } } in @@ -177,7 +180,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)