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 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
data Context h
= Context {
cConfig ∷ !Config
- , cResTree ∷ !ResTree
- , cFallbacks ∷ ![FallbackHandler]
+ , cSchemeMap ∷ !SchemeMap
, cHandle ∷ !h
, cPort ∷ !PortNumber
, cAddr ∷ !SockAddr
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
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 {