X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;fp=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=543c82e52e182524460a13d95efb09295fdd4578;hp=062ffe204ec192e5f5b0d0e52131f352989752d4;hb=90fca0675b1694e69b8e431c989343855cbd125d;hpb=742b0cae221f12eafbf1379b91c473b059efa7d8 diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs index 062ffe2..543c82e 100644 --- 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 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 Data.Default import Data.List import Data.Maybe import Data.Monoid.Unicode @@ -95,7 +95,7 @@ acceptRequest ctx@(Context {..}) input 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 @@ -114,15 +114,15 @@ acceptParsableRequest ctx@(Context {..}) req input 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 - Just (path, def) - → acceptRequestForResource ctx ar input path def + Just (path, rsrc) + → acceptRequestForResource ctx ar input path rsrc acceptSemanticallyInvalidRequest ∷ HandleLike h ⇒ Context h @@ -141,7 +141,7 @@ acceptRequestForResource ∷ HandleLike h → [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 @@ -149,7 +149,7 @@ acceptRequestForResource ctx@(Context {..}) ar@(AugmentedRequest {..}) input rsr #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