I have a smallish Yesod application (using the scaffold). I'd like to add basic HTTP authentication to all requests. Here's what I tried so far:
I've read the docs on Yesod authentication, but there's unfortunately no backend supporting this.
isAuthorized would be great, but I can't see a way to read the headers there.
A WAI middleware would be elegant, but I can't find any documentation describing how to use one with a full Yesod application. It's also pretty clear that writing one is not completely trivial.
Was this already done? How should I approach this?
I've come up with a non-ideal solution: I prepend an action to all my handler functions. Maybe it'll be useful for someone, maybe someone can improve upon this. Here's the code:
httpBasicAuth :: Handler ()
httpBasicAuth = do
request <- waiRequest
case lookup "Authorization" (requestHeaders request) of
Just "Basic base64encodedusernameandpassword" -> return ()
_ -> do
setHeader "WWW-Authenticate" "Basic Realm=\"My Realm\""
permissionDenied "Authentication required"
And using it:
fooR :: Handler ()
fooR = httpBasicAuth >> do
sendResponseStatus status200 ()
I'll be more than happy to move the "accepted" checkmark if a better solution is posted.
Related
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.
I want to return some preformatted html in a snap application. However, when the handler below is served,
aPage :: Handler App App ()
aPage = do
writeText "<p>This is a page</p>"
The output is couched in < pre > tags.
...<body><pre><p>This is a page</p></pre></body> ...
Is there a simple way to add a verbatim string to the response body?
You don't.
As Carl pointed out in the comment to my question, it was not "escaped" to begin with. What I was seeing was the browsers rendition of the plaintext document. Simply sending a properly formatted document gives me what I was expecting.
aPage :: Handler App App ()
aPage = do
writeText "<!DOCTYPE html><html><head></head><body><p>This is a page</p></body></html>"
After fiddling with Blaze-html and Lucid, two libraries for generating html, I was sure some sort of formatting was going on under the hood and thought some sort of toHtmlRaw function was needed. Not at all the answer I was expecting.
For context, this is an authentication situation. In my application, if the client is not authenticated, then the app obviously needs to respond appropriately. The challenge comes up when I want to choose a different response based on the type of application calling into the server.
Here is an example of a route:
server = Header "Cookie" (AuthToken Unverified)
:> "api" :> "history" :> Get '[HTML, JSON] HistoryPage
So, an HTML response would be for a CGI app. In general, it should either render an authentication page, or it should throw a 303 to direct the user to an authentication page.
But a JSON response would be for a Javascript app, and there I want to simply return a 404, because the Javascript would have other ways of doing authentication.
Here is my top-level handler:
newtype WebM a = WebM (ReaderT Context (ExceptT WebExc IO) a)
data WebExc = OtherExceptionTypes
| AppUnauthorized
runWeb :: Context -> WebM :~> Handler
runWeb ctx#Context{..} = Nat $ \(WebM action) -> withExceptT trExc $ runReaderT action ctx
where
trExc :: WebExc -> ServantErr
trExc AppUnauthorized = err303 { .. }
I've tried creating my own Javascript content-type, but the MimeRenderer doesn't allow me to throw exceptions. The only idea I have so far is to capture the "Accept" header and throw either 303 or 404 from within the handler. But that is gross because the handler isn't supposed to know anything about the actual client app.
Is there any cleaner way to handle this?
Not exactly answering what you asked, but in the greater picture, this sounds like a use-case for two separate routes, with a common bit of implementation shared between them.
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.
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.