Done.

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

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 55c2166aba9d438cf689ee6e949c851c733d547a..91aa86dc61be20313b4b672b59806177441d3399 100644 (file)
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -16,13 +16,15 @@ import Control.Exception hiding (block)
 import Control.Monad
 import Control.Monad.Trans.Maybe
 import qualified Data.Attoparsec.Lazy as LP
+import Data.Attoparsec.Parsable
 import qualified Data.ByteString as Strict
 import qualified Data.ByteString.Lazy as Lazy
+import Data.Convertible.Base
+import Data.Convertible.Instances.Text ()
 import Data.List
 import Data.Maybe
 import Data.Monoid.Unicode
 import qualified Data.Sequence as S
-import qualified Data.Text as T
 import Network.HTTP.Lucu.Abortion
 import Network.HTTP.Lucu.Config
 import Network.HTTP.Lucu.Chunk
@@ -40,12 +42,12 @@ import System.IO (hPutStrLn, stderr)
 
 data Context h
     = Context {
-        cConfig    ∷ !Config
-      , cSchemeMap ∷ !SchemeMap
-      , cHandle    ∷ !h
-      , cPort      ∷ !PortNumber
-      , cAddr      ∷ !SockAddr
-      , cQueue     ∷ !InteractionQueue
+        cConfig  ∷ !Config
+      , cHostMap ∷ !HostMap
+      , cHandle  ∷ !h
+      , cPort    ∷ !PortNumber
+      , cAddr    ∷ !SockAddr
+      , cQueue   ∷ !InteractionQueue
       }
 
 data ChunkReceivingState
@@ -53,17 +55,17 @@ data ChunkReceivingState
     | InChunk !Int -- ^Number of remaining octets in the current
                    -- chunk. It's always positive.
 
-requestReader ∷ HandleLike h
+requestReader ∷ (HostMapper hm, HandleLike h)
               ⇒ Config
-              → SchemeMap
+              → hm
               → h
               → PortNumber
               → SockAddr
               → InteractionQueue
               → IO ()
-requestReader cnf sm h port addr tQueue
+requestReader cnf hm h port addr tQueue
     = do input ← hGetLBS h
-         acceptRequest (Context cnf sm h port addr tQueue) input
+         acceptRequest (Context cnf (hostMap hm) h port addr tQueue) input
       `catches`
       [ Handler handleAsyncE
       , Handler handleOthers
@@ -93,7 +95,7 @@ acceptRequest ctx@(Context {..}) input
          if Lazy.null input then
              return ()
          else
-             case LP.parse request input of
+             case LP.parse parser input of
                LP.Done input' req → acceptParsableRequest ctx req input'
                LP.Fail _ _ _      → acceptNonparsableRequest ctx
 
@@ -112,7 +114,7 @@ acceptParsableRequest ctx@(Context {..}) req input
          if isError $ arInitialStatus ar then
              acceptSemanticallyInvalidRequest ctx ar input
          else
-             do rsrc ← runMaybeT $ dispatch (reqURI $ arRequest ar) cSchemeMap
+             do rsrc ← runMaybeT $ dispatch (reqURI $ arRequest ar) cHostMap
                 case rsrc of
                   Nothing
                       → do let ar' = ar {
@@ -298,11 +300,11 @@ chunkWasMalformed tid eCtx e msg
     = let abo = mkAbortion BadRequest [("Connection", "close")]
                 $ Just
                 $ "chunkWasMalformed: "
-                ⊕ T.pack msg
+                ⊕ cs msg
                 ⊕ ": "
-                ⊕ T.pack (intercalate ", " eCtx)
+                ⊕ cs (intercalate ", " eCtx)
                 ⊕ ": "
-                ⊕ T.pack e
+                ⊕ cs e
       in
         throwTo tid abo