Unexpected conduit behaviour with wai - haskell

I'm trying to write a really trivial "echo" webapp using wai; all I want it to do is reply with the data that is POSTed to it (I really don't care about the method, but I'm using curl and curl is using POST, so that's what I'm going for). My trivial web server is this:
import Network.Wai
import Network.HTTP.Types (status200)
import Network.Wai.Handler.Warp (run)
import Control.Monad.Trans ( liftIO )
import Blaze.ByteString.Builder.ByteString (fromByteString)
import qualified Data.Conduit.List as CondList
import Data.Conduit ( ($$), ($=), Flush(Chunk) )
application req = do
let src = requestBody req $= CondList.map (Chunk ∘ fromByteString)
return $ ResponseSource status200 [("Content-Type", "text/plain")] src
main = run 3000 application
What I expected this to do is basically tie the request body to the response body, so that when I run curl --data #/usr/share/dict/words localhost:3000; it would spit my words file back at me. Instead, it gives an empty body. Running curl with "-v" shows that my app is replying with a "200 OK" and no data. I'm not sure what I'm doing wrong here.
If I replace the application function with this:
_ ← requestBody req $$ CondList.mapM_ (liftIO ∘ print)
return $ responseLBS status200 [("Content-Type", "text/plain")] "Hello world\n"
and add an OverloadedStrings pragma to allow the "Hello World" part to work, then I do see my app printing the entire request body to stdout, so I know that curl is submitting the data properly. I also get "Hello World" printed to the curl stdout, so I know that curl works as I expect it to. I must be doing something wrong where I'm tying my requestBody to my ResponseSource, but I don't see it.

You're correctly using conduit, the problem is that the streaming behavior you're trying to get cannot reliably work in the context of HTTP. Essentially, you want to start sending the response body while the client is sending the request body. This could lead to a deadlock, as both the client and server could be stuck in send mode. To avoid this, Warp flushes the request body before sending the response, which is why the request body appears empty at the time the response body is sent.
In order to get the echo behavior correct, you would need to strictly consume the request body and then send it back. Obviously this could be problematic from a memory usage standpoint if there's a large request body, but this is an inherent aspect of HTTP. If you want constant memory echo, my recommendation would be to stream the request body to a file, and then use ResponseFile for the response body.

Related

How to set HTTP status code manually in IHP response

Context
I am using EasyCron (https://www.easycron.com) to ping an endpoint in my IHP app.
If the code on my app's side fails for some reason, I would like to set the HTTP status code to 503 or similar and display the errors in the response so that,
the cron job is marked as failed on EasyCron and
I can see the relevant IHP errors in EasyCron's cron job records.
Since my response is not going to be parsed by EasyCron, I don't need it to be in JSON format. It's just going to be saved in the logs.
Question
I see that there is renderJsonWithStatusCode but since I have no need to parse the JSON and it is extra work to create JSON instances of my data, I would prefer to render a plain text response but with a custom status code. Is this possible?
You can set a custom status code by calling IHP's respondAndExit with a custom response:
import Network.Wai (responseLBS)
import Network.HTTP.Types (status503)
import Network.HTTP.Types.Header (hContentType)
action MyAction = do
let text = "An error happend"
respondAndExit $ responseLBS status503 [(hContentType, "text/plain")] text

Setup Wai Middleware request logger to drop (not log) some requests

I have an app where the Nginx reverse proxy is making a lot of requests to my health endpoint. I'd like to not log these at all so my output logs are smaller. I'm also logging everything as JSON using Network.Wai.Middleware.RequestLogger.JSON, which has a function to format log messages as JSON.
One thing I could do is log an empty bytestring, but I was thinking there may be some way to no-op the log call. I can't figure out how to do that from looking at the various RequestLogger functions in wai-extra.
Does anyone have a recommendation for how to build a custom Middleware in order to not-log certain requests?
I created a custom formatter in the following way:
-- | Wai Application Middleware logger
jsonRequestLogger :: IO Middleware
jsonRequestLogger = mkRequestLogger
$ def { outputFormat = CustomOutputFormatWithDetails dontLogHealthEndpoint }
dontLogHealthEndpoint :: OutputFormatterWithDetails
dontLogHealthEndpoint date req status responseSize duration reqBody response =
if B.isInfixOf "health" $ rawPathInfo req
then toLogStr B.empty
else formatAsJSON date req status responseSize duration reqBody response
This seems to work fine. However, I'd still like to know if there's a better way.

How can I limit size of request body and headers in WAI?

I am developing an application using Scotty and of course WAI. I would like to be able to limit the size of requests, both for body length and for headers. How can I do that? Is it possible to do it using a plain WAI middleware ?
I don't know details of Scotty, but it's certainly possible to set up a WAI middleware that will look at the requestBodyLength and, if it's too large, return an appropriate 413 status code page. One thing you'd need to deal with is if the upload body is sent with chunked encoding, in which case no content-length is present. but that's uncommon. You have the option of either rejecting those requests, or adding code to wrap the request body and return an error if it turns out to be too large (that's what Yesod does).
The marked solution points in the correct direction, but if you're like me you might still struggle to explicitely derive the full code needed. Here is an implementation (thanks to the help of an experienced Haskell friend):
import qualified Network.HTTP.Types as Http
import qualified Network.Wai as Wai
limitRequestSize :: Wai.Middleware
limitRequestSize app req respond = do
case Wai.requestBodyLength req of
Wai.KnownLength len -> do
if len > maxLen
then respond $ Wai.responseBuilder Http.status413 [] mempty
else app req respond
Wai.ChunkedBody ->
respond $ Wai.responseBuilder Http.status411 [] mempty
where
maxLen = 50*1000 -- 50kB
The middleware then just runs in scotty's do block like this
import Network.Wai.Middleware.RequestLogger (logStdout)
main :: IO ()
main = do
scotty 3000 $ do
middleware logStdout
middleware limitRequestSize
get "/alive" $ do
status Http.status200
-- ...
If you're curious as to how to derive it (or why I found this not overly trivial), consider that Middleware is an alias for
Application -> Application
where Application itself is an alias for
Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
Hence there are quite a bunch of arguments to (mentally) unpack, even if the solution is pretty terse.
As of wai-extra-3.1.1 the code described above has been added to the Network.Wai.Middleware.RequestSizeLimit module, so it can just be pulled in as a dependency.

Parsing POST body using Wai and Warp [closed]

This question is unlikely to help any future visitors; it is only relevant to a small geographic area, a specific moment in time, or an extraordinarily narrow situation that is not generally applicable to the worldwide audience of the internet. For help making this question more broadly applicable, visit the help center.
Closed 10 years ago.
I am trying to use Wai and Warp to write a modest HTTP server and I am stuck trying to read POST/PUT request's bodies to extract form parameters. When I do the following
{-# LANGUAGE OverloadedStrings #-}
import Network.Wai.Handler.Warp (run)
import qualified Data.ByteString.Char8 as C
import Network.Wai.Parse (parseRequestBody, lbsSink)
import Network.Wai(Response(..))
import Network.HTTP.Types(status200)
import Blaze.ByteString.Builder
main = run 3000 app
app req = do
(params, _) <- parseRequestBody lbsSink req
let r = C.concat $ map (\(x,y) -> C.concat [x,y]) params
return $ ResponseBuilder
status200
[("Content-Type", "text/plain")]
$ fromByteString r
and then I try a simple request like
curl -o - -X POST http://localhost:3000/ -d name=toto
it appears my parameters don't get passed to other server, or rather do not get decoded properly as nothing is returned.

Catch exceptions in Happstack

I got an exception (used Prelude.head on an empty list) that made all the http-request after that return a 502/505 exception (and the happstack app prints "HTTP request failed with: send resource vanished (Broken pipe)" in stdout).
My question is this: What is the best practice for controlling exceptions in Happstack? Should I use something else than simpleHTTP or simply use Control.Exception.catch on the controller function?
It currently looks similar to the example in the Crash Course:
main :: IO ()
main = do
hSetEncoding stdout utf8
bracket (startSystemState (Proxy :: Proxy AppState)) createCheckpointAndShutdown $
\_control ->
simpleHTTP nullConf { port = 1729 } $ do
_ <- liftIO today
decodeBody policy
controller
where
createCheckpointAndShutdown control = do
createCheckpoint control
shutdownSystem control
What do you mean by, "the server went down"?
If you are handling a Request and do head [], that should only kill the thread that is handling that particular request. The server itself should continue running and processing other requests.
If you have found a way to kill the whole server, that is a bug and bug report / test case would be highly appreciated.
If only the current thread is being killed, and you want to catch that exception, then I think you need to use MonadPeelIO,
http://hackage.haskell.org/packages/archive/monad-peel/0.1/doc/html/Control-Monad-IO-Peel.html
Someone has submitted a patch for that, but it has not been reviewed/merged yet.

Resources