- = do case find ((== "boundary") . map toLower . fst) params of
- Nothing
- -> abort BadRequest [] (Just "Missing boundary of multipart/form-data")
- Just (_, boundary)
- -> do src <- inputLBS limit
- case parse (multipartFormP boundary) src of
- (# Success fdList, _ #) -> return fdList
- (# _, _ #)
- -> abort BadRequest [] (Just "Unparsable multipart/form-data")
-
--- | This is just a constant @-1@. It's better to say @'input'
--- 'defaultLimit'@ than to say @'input' (-1)@ but these are exactly
--- the same.
-defaultLimit :: Int
-defaultLimit = (-1)
-
-
-
-{- DecidingHeader 時に使用するアクション群 -}
-
--- | Set the response status code. If you omit to compute this action,
--- the status code will be defaulted to \"200 OK\".
-setStatus :: StatusCode -> Resource ()
-setStatus code
- = code `seq`
- do driftTo DecidingHeader
- itr <- getInteraction
- liftIO $! atomically $! updateItr itr itrResponse
- $! \ res -> res {
- resStatus = code
- }
-
--- | Set a value of given resource header. Comparison of header name
--- is case-insensitive. Note that this action is not intended to be
--- used so frequently: there should be actions like 'setContentType'
--- for every common headers.
---
--- Some important headers (especially \"Content-Length\" and
--- \"Transfer-Encoding\") may be silently dropped or overwritten by
--- the system not to corrupt the interaction with client at the
--- viewpoint of HTTP protocol layer. For instance, if we are keeping
--- the connection alive, without this process it causes a catastrophe
--- to send a header \"Content-Length: 10\" and actually send a body of
--- 20 bytes long. In this case the client shall only accept the first
--- 10 bytes of response body and thinks that the residual 10 bytes is
--- a part of header of the next response.
-setHeader :: Strict.ByteString -> Strict.ByteString -> Resource ()
-setHeader name value
- = name `seq` value `seq`
- driftTo DecidingHeader >> setHeader' name value
-
-
-setHeader' :: Strict.ByteString -> Strict.ByteString -> Resource ()
-setHeader' name value
- = name `seq` value `seq`
- do itr <- getInteraction
- liftIO $ atomically
- $ updateItr itr itrResponse
- $ H.setHeader name value
-
--- | Computation of @'redirect' code uri@ sets the response status to
--- @code@ and \"Location\" header to @uri@. The @code@ must satisfy
--- 'Network.HTTP.Lucu.Response.isRedirection' or it causes an error.
-redirect :: StatusCode -> URI -> Resource ()
+ = case M.lookup "boundary" params of
+ Nothing
+ → abort $ mkAbortion' BadRequest "Missing boundary of multipart/form-data"
+ Just boundary
+ → do src ← getChunks limit
+ b ← case A.fromText boundary of
+ Just b → return b
+ Nothing → abort $ mkAbortion' BadRequest
+ $ "Malformed boundary: " ⊕ boundary
+ case LP.parse (p b) src of
+ LP.Done _ formList
+ → return formList
+ _ → abort $ mkAbortion' BadRequest "Unparsable multipart/form-data"
+ where
+ p b = do xs ← multipartFormP b
+ P.endOfInput
+ return xs
+
+-- |@'redirect' code uri@ declares the response status as @code@ and
+-- \"Location\" header field as @uri@. The @code@ must satisfy
+-- 'isRedirection' or it raises an error.
+redirect ∷ StatusCode → URI → Resource ()