Still working on Router arrow

[Lucu.git] / Network / HTTP / Lucu / RequestReader.hs

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 062ffe204ec192e5f5b0d0e52131f352989752d4..497db9320a0d2e87b6dc23d903bc24b213eb6246 100644 (file)
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -16,11 +16,11 @@ import Control.Exception hiding (block)
 import Control.Monad
 import Control.Monad.Trans.Maybe
 import qualified Data.Attoparsec.Lazy as LP
 import Control.Monad
 import Control.Monad.Trans.Maybe
 import qualified Data.Attoparsec.Lazy as LP

-import Data.Attoparsec.Parsable

 import qualified Data.ByteString as Strict
 import qualified Data.ByteString.Lazy as Lazy
 import Data.Convertible.Base
 import Data.Convertible.Instances.Text ()
 import qualified Data.ByteString as Strict
 import qualified Data.ByteString.Lazy as Lazy
 import Data.Convertible.Base
 import Data.Convertible.Instances.Text ()

+import Data.Default

 import Data.List
 import Data.Maybe
 import Data.Monoid.Unicode
 import Data.List
 import Data.Maybe
 import Data.Monoid.Unicode


@@ -34,6 +34,7 @@ import Network.HTTP.Lucu.Interaction
 import Network.HTTP.Lucu.Preprocess
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
 import Network.HTTP.Lucu.Preprocess
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response

+import Network.HTTP.Lucu.Response.StatusCode

 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Utils
 import Network.Socket
 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Utils
 import Network.Socket


@@ -95,7 +96,7 @@ acceptRequest ctx@(Context {..}) input
          if Lazy.null input then
              return ()
          else
          if Lazy.null input then
              return ()
          else

-             case LP.parse parser input of
+             case LP.parse def input of

                LP.Done input' req → acceptParsableRequest ctx req input'
                LP.Fail _ _ _      → acceptNonparsableRequest ctx
 
                LP.Done input' req → acceptParsableRequest ctx req input'
                LP.Fail _ _ _      → acceptNonparsableRequest ctx
 


@@ -110,19 +111,19 @@ acceptParsableRequest ∷ HandleLike h
                       → Lazy.ByteString
                       → IO ()
 acceptParsableRequest ctx@(Context {..}) req input
                       → Lazy.ByteString
                       → IO ()
 acceptParsableRequest ctx@(Context {..}) req input

-    = do let ar = preprocess (cnfServerHost cConfig) cPort req
+    = do let ar = preprocess (cnfServerHost cConfig) cPort (hIsSSL cHandle) req

          if isError $ arInitialStatus ar then
              acceptSemanticallyInvalidRequest ctx ar input
          else
          if isError $ arInitialStatus ar then
              acceptSemanticallyInvalidRequest ctx ar input
          else

-             do rsrc ← runMaybeT $ dispatch (reqURI $ arRequest ar) cHostMap
-                case rsrc of
+             do rsrcM ← runMaybeT $ dispatch (reqURI $ arRequest ar) cHostMap
+                case rsrcM of

                   Nothing
                       → do let ar' = ar {
                                        arInitialStatus = fromStatusCode NotFound
                                      }
                            acceptSemanticallyInvalidRequest ctx ar' input
                   Nothing
                       → do let ar' = ar {
                                        arInitialStatus = fromStatusCode NotFound
                                      }
                            acceptSemanticallyInvalidRequest ctx ar' input

-                  Just (path, def)
-                      → acceptRequestForResource ctx ar input path def
+                  Just (path, rsrc)
+                      → acceptRequestForResource ctx ar input path rsrc

 
 acceptSemanticallyInvalidRequest ∷ HandleLike h
                                  ⇒ Context h
 
 acceptSemanticallyInvalidRequest ∷ HandleLike h
                                  ⇒ Context h


@@ -141,7 +142,7 @@ acceptRequestForResource ∷ HandleLike h
                          → [Strict.ByteString]
                          → Resource
                          → IO ()
                          → [Strict.ByteString]
                          → Resource
                          → IO ()

-acceptRequestForResource ctx@(Context {..}) ar@(AugmentedRequest {..}) input rsrcPath rsrcDef
+acceptRequestForResource ctx@(Context {..}) ar@(AugmentedRequest {..}) input rsrcPath rsrc

     = do
 #if defined(HAVE_SSL)
          cert ← hGetPeerCert cHandle
     = do
 #if defined(HAVE_SSL)
          cert ← hGetPeerCert cHandle


@@ -149,7 +150,7 @@ acceptRequestForResource ctx@(Context {..}) ar@(AugmentedRequest {..}) input rsr
 #else
          ni   ← mkNormalInteraction cConfig cAddr ar rsrcPath
 #endif
 #else
          ni   ← mkNormalInteraction cConfig cAddr ar rsrcPath
 #endif

-         tid  ← spawnRsrc rsrcDef ni
+         tid  ← spawnRsrc rsrc ni

          enqueue ctx ni
          if reqHasBody arRequest then
              waitForReceiveBodyReq ctx ni tid input
          enqueue ctx ni
          if reqHasBody arRequest then
              waitForReceiveBodyReq ctx ni tid input