X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=543c82e52e182524460a13d95efb09295fdd4578;hb=90fca0675b1694e69b8e431c989343855cbd125d;hp=91aa86dc61be20313b4b672b59806177441d3399;hpb=1de2506621977a383b991cadce024f626023908b;p=Lucu.git diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs index 91aa86d..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,9 +149,9 @@ 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 reqMustHaveBody arRequest then + if reqHasBody arRequest then waitForReceiveBodyReq ctx ni tid input else acceptRequest ctx input