X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=55c2166aba9d438cf689ee6e949c851c733d547a;hb=761b90ab4f413d2e83460f170082f3b15bbaef4f;hp=74720b10ad6b9975a7d569379a2249d8a0f9df66;hpb=9ed4b7476710930bb537c71d0c2341d7ea331767;p=Lucu.git diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs index 74720b1..55c2166 100644 --- a/Network/HTTP/Lucu/RequestReader.hs +++ b/Network/HTTP/Lucu/RequestReader.hs @@ -14,6 +14,7 @@ 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 @@ -25,13 +26,13 @@ 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 @@ -40,8 +41,7 @@ import System.IO (hPutStrLn, stderr) data Context h = Context { cConfig ∷ !Config - , cResTree ∷ !ResTree - , cFallbacks ∷ ![FallbackHandler] + , cSchemeMap ∷ !SchemeMap , cHandle ∷ !h , cPort ∷ !PortNumber , cAddr ∷ !SockAddr @@ -55,16 +55,15 @@ data ChunkReceivingState requestReader ∷ HandleLike h ⇒ Config - → ResTree - → [FallbackHandler] + → SchemeMap → h → PortNumber → SockAddr → InteractionQueue → IO () -requestReader cnf tree fbs h port addr tQueue +requestReader cnf sm h port addr tQueue = do input ← hGetLBS h - acceptRequest (Context cnf tree fbs h port addr tQueue) input + acceptRequest (Context cnf sm h port addr tQueue) input `catches` [ Handler handleAsyncE , Handler handleOthers @@ -113,7 +112,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) cSchemeMap case rsrc of Nothing → do let ar' = ar { @@ -138,7 +137,7 @@ acceptRequestForResource ∷ HandleLike h → AugmentedRequest → Lazy.ByteString → [Strict.ByteString] - → ResourceDef + → Resource → IO () acceptRequestForResource ctx@(Context {..}) ar@(AugmentedRequest {..}) input rsrcPath rsrcDef = do @@ -148,7 +147,7 @@ acceptRequestForResource ctx@(Context {..}) ar@(AugmentedRequest {..}) input rsr #else ni ← mkNormalInteraction cConfig cAddr ar rsrcPath #endif - tid ← spawnResource rsrcDef ni + tid ← spawnRsrc rsrcDef ni enqueue ctx ni if reqMustHaveBody arRequest then waitForReceiveBodyReq ctx ni tid input