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.Maybe
import Data.Text (Text)
import qualified Data.Text as T
data AugmentedRequest
= AugmentedRequest {
arRequest ∷ !Request
- , arInitialStatus ∷ !StatusCode
+ , arInitialStatus ∷ !SomeStatusCode
, arWillChunkBody ∷ !Bool
, arWillDiscardBody ∷ !Bool
, arWillClose ∷ !Bool
| 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
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
→ setWillClose True
HttpVersion 1 1
→ modify $ \ar → ar { arWillChunkBody = True }
- _ → do setStatus HttpVersionNotSupported
+ _ → do setStatus HTTPVersionNotSupported
setWillClose True
examineMethod ∷ State AugmentedRequest ()
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) $
-- 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
-- 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
+ , uriRegName = T.unpack $ CI.original host
, uriPort = A.toString port
}
}