X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=6c5070b5738c0e54d4bce48f809219f6db97eb93;hb=c9a2696;hp=4c59b3e9f8b1ac5a1524d634d2595a339c80c853;hpb=1ead053df6a792edafa9d714c4c038a8a9c3ad16;p=Lucu.git diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs index 4c59b3e..6c5070b 100644 --- a/Network/HTTP/Lucu/RequestReader.hs +++ b/Network/HTTP/Lucu/RequestReader.hs @@ -14,24 +14,26 @@ import Control.Concurrent import Control.Concurrent.STM import Control.Exception hiding (block) import Control.Monad +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 +import Network.HTTP.Lucu.Dispatcher.Internal import Network.HTTP.Lucu.HandleLike import Network.HTTP.Lucu.Interaction import Network.HTTP.Lucu.Preprocess import Network.HTTP.Lucu.Request import Network.HTTP.Lucu.Response import Network.HTTP.Lucu.Resource.Internal -import Network.HTTP.Lucu.Resource.Tree import Network.HTTP.Lucu.Utils import Network.Socket import Prelude.Unicode @@ -39,13 +41,12 @@ import System.IO (hPutStrLn, stderr) data Context h = Context { - cConfig ∷ !Config - , cResTree ∷ !ResTree - , cFallbacks ∷ ![FallbackHandler] - , cHandle ∷ !h - , cPort ∷ !PortNumber - , cAddr ∷ !SockAddr - , cQueue ∷ !InteractionQueue + cConfig ∷ !Config + , cHostMap ∷ !HostMap + , cHandle ∷ !h + , cPort ∷ !PortNumber + , cAddr ∷ !SockAddr + , cQueue ∷ !InteractionQueue } data ChunkReceivingState @@ -53,18 +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 - → ResTree - → [FallbackHandler] + → hm → h → PortNumber → SockAddr → InteractionQueue → IO () -requestReader cnf tree fbs h port addr tQueue +requestReader cnf hm h port addr tQueue = do input ← hGetLBS h - acceptRequest (Context cnf tree fbs h port addr tQueue) input + acceptRequest (Context cnf (hostMap hm) h port addr tQueue) input `catches` [ Handler handleAsyncE , Handler handleOthers @@ -113,7 +113,7 @@ acceptParsableRequest ctx@(Context {..}) req input if isError $ arInitialStatus ar then acceptSemanticallyInvalidRequest ctx ar input else - do rsrc ← findResource cResTree cFallbacks $ reqURI $ arRequest ar + do rsrc ← runMaybeT $ dispatch (reqURI $ arRequest ar) cHostMap case rsrc of Nothing → do let ar' = ar { @@ -299,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