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.Default
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.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
if Lazy.null input then
return ()
else
- case LP.parse request input of
+ case LP.parse def input of
LP.Done input' req → acceptParsableRequest ctx req input'
LP.Fail _ _ _ → acceptNonparsableRequest ctx
→ 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
- 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
→ [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
#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
= 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