X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=6c5070b5738c0e54d4bce48f809219f6db97eb93;hb=c9a269666f2d60d9c5ba817e1c43b45f6d77de22;hp=37ab99296c2e0b7dff2eb7321e37ef6633e70a54;hpb=1b822bc79ce9fd0ee537fe81819e7501af83f7bd;p=Lucu.git

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 37ab992..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,21 +54,19 @@ 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 handleBIOS
       , Handler handleOthers
       ]
       `finally`
@@ -77,15 +76,12 @@ requestReader cnf tree fbs h port addr tQueue
       handleAsyncE ThreadKilled = return ()
       handleAsyncE e            = dump e
 
-      handleBIOS ∷ BlockedIndefinitelyOnSTM → IO ()
-      handleBIOS = dump
-
       handleOthers ∷ SomeException → IO ()
       handleOthers = dump
 
       dump ∷ Exception e ⇒ e → IO ()
       dump e
-          = do hPutStrLn stderr "requestReader caught an exception:"
+          = do hPutStrLn stderr "Lucu: requestReader caught an exception:"
                hPutStrLn stderr $ show e
 
 acceptRequest ∷ HandleLike h ⇒ Context h → Lazy.ByteString → IO ()
@@ -117,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 {
@@ -142,7 +138,7 @@ acceptRequestForResource ∷ HandleLike h
                          → AugmentedRequest
                          → Lazy.ByteString
                          → [Strict.ByteString]
-                         → ResourceDef
+                         → Resource
                          → IO ()
 acceptRequestForResource ctx@(Context {..}) ar@(AugmentedRequest {..}) input rsrcPath rsrcDef
     = do
@@ -152,7 +148,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
@@ -303,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