X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=6c5070b5738c0e54d4bce48f809219f6db97eb93;hb=c9a269666f2d60d9c5ba817e1c43b45f6d77de22;hp=55c2166aba9d438cf689ee6e949c851c733d547a;hpb=667baf9f664ccc093241287ad727b2839290f456;p=Lucu.git diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs index 55c2166..6c5070b 100644 --- a/Network/HTTP/Lucu/RequestReader.hs +++ b/Network/HTTP/Lucu/RequestReader.hs @@ -18,11 +18,12 @@ import Control.Monad.Trans.Maybe import qualified Data.Attoparsec.Lazy as LP 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 +41,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 +54,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 @@ -112,7 +113,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 +299,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