X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FPreprocess.hs;h=1284f2b322749e2e69dcd0d69702065a7aa99644;hp=3a02ad8f194c4a0b6e41cd850e59725a0030752f;hb=24d6b6e25e79495eaa00eb6eacdb707d181d0770;hpb=b87f64c979c79592e6824ee531478eacdaa384bb

diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs
index 3a02ad8..1284f2b 100644
--- a/Network/HTTP/Lucu/Preprocess.hs
+++ b/Network/HTTP/Lucu/Preprocess.hs
@@ -16,6 +16,8 @@ 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.Maybe
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -44,7 +46,7 @@ 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
@@ -104,7 +106,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,22 +135,22 @@ 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
           -- 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
                                   }
                  }