In servant, how can I select my exception based on Accept header? - haskell

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.

Related

Reading file contents once at haskell application startup

I have an API written using the Servant library which connects to a postgres db. The connection string for my db is stored in a configuration file. Everytime I make a request to any endpoint that interacts with the db I have to read the file to get the connection string, this is what im trying to avoid.
Step by step example of what im trying to achieve:
Application starts up.
Contents of the config file are read and bound to some type/object.
I make a request to my endpoint to create an entry in the db.
I read the connection string from the type/object that I bound it to and NOT the config file.
Every subsequent request for the lifetime of the application does not have to read the config file everytime it wants to interact with the database.
Doing this in something like java/c# you would just bind the contents of a file to some POCO which would be added to your DI container as a singleton so it can be referenced anywhere in your application and persist between each api request. If I have 100 requests that ineract with the db, none of those 100 requests would need to read config file to get the connection string as it was already loaded into memory when the app started.
I have thought about using the cache package, but is there an easier way to do something like this without a third party package?
Let's begin with this trivial Servant server:
import Servant
import Servant.Server
type FooAPI = Get '[JSON] Int
fooServer :: Server FooAPI
fooServer = pure 1
Suppose we don't want to hardcode that 1. We could turn fooServer into a function like
makeFooServer :: Int -> Server FooAPI
makeFooServer n = pure n
Then, in main, we could read the n from a file then call makeFooServer to construct the server. Something similar could be done for your database connection.
There's another approach that might be sometimes preferrable. Servant lets you define servers whose handlers live in a monad different from Handler, and then transform them into regular servers (tutorial).
We can write a server in which the handler monad is a ReaderT holding the configuration:
import Control.Monad.Trans.Reader
type RHandler env = ReaderT env Handler
fooServer' :: ServerT FooAPI (RHandler Int)
fooServer' = do
n <- ask
pure n
Where ServerT is a more general form of Server that lets you specify the handler monad in an extra type argument.
Then, we use the hoistServer function to supply the initial environment and go back to a regular server:
-- "Server FooAPI" is the same as "ServerT FooAPI Handler"
-- so the transformation we need is simply to run the `ReaderT`
-- by supplying an environment.
backToNormalServer :: Int -> Server FooAPI
backToNormalServer n = hoistServer (Proxy #FooAPI) (flip runReaderT n) fooServer'
The ServerT FooAPI (RHandler Int) approach has the advantage that you still have a server value that you can directly manipulate and pass around, instead of it being the result of a function.
Also, for some advanced use cases, the environment might reflect information derived from the structure of each endpoint.

Haskell Servant and streaming

I am trying to add a functionality to my servant server that would get a file from Amazon S3 and stream it back to the user.
Because files can be big I don't want to download them locally and then serve them to clients, I'd rather prefer to stream them directly from S3 to clients.
I use Amazonka for what I do with S3 and I can get a stream for an S3 file as a Conduit sink.
But now I don't know how to get from Sink to EitherT ServantErr IO a.
Can anyone explain me how to do it or show me some example of how it can be done?
The is nothing in Servant to do this out of the box, however all the needed parts are available.
Before we begin, I guess that if you can stream to a Sink, that means you have a source (the gorsBody of GetObjectResponse is a RsBody, which is a Source)
First of all, Servant provides us with the possibility to add support for new return types, by creating a new instance of HasServer, so we could serve a EitherT ServantErr IO (Source ...) and have it stream.
To create that instance, we must implement route :: Proxy layout -> Server layout -> RoutingApplication. Server layout, in this case, just means EitherT ServantErr IO layout, layout being the source we want to server, so it's the function that returns a source (and may fail with an HTTP error).
We have to return a RoutingApplication, which is (in continuation style) a function that takes a Request and returns a RouteResult Response, which means either an unmatched route error, or a response. Both Request and Response are standard wai, not Servant, so we can now look at the rest of the ecosystem to find how to implement it.
Fortunately, we don't have to go far: Network.Wai.Conduit contains just what we need to implement the route function: responseSource takes a status value, some response headers and your source and gives you a Response.
So, that is quite a lot of work to do, but everything we need is there. Looking a the source of the instance HasServer * (Get ...) might help.

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.

What should the type be for a subsite widget that can be used in a master site?

I have written a Yesod auth plugin that mails out invite codes, which are then required for registration. One thing that I would like to include in the plugin is a widget containing a form for creating invitations; the form would post to a route within the auth plugin. What I'm having trouble with is figuring out a type signature for the widget that allows the creation of the appropriate URL and can also be used within a handler for the master site.
Stripped down to the essentials, the widget looks like:
invitationWidget :: GWidget Auth m ()
invitationWidget = do
tm <- lift getRouteToMaster
[whamlet|<form action=#{tm inviteR}>|]
inviteR :: AuthRoute
inviteR = PluginR "invite" ["invite"]
The trouble is that specifying the Auth subsite for the widget means that I can't embed it directly into a handler of type GHandler master master a (the exact error is Couldn't match type `App' with `Yesod.Auth.Auth'). However, if the subsite isn't specified, e.g. invitationWidget :: GWidget s m (), then I don't see a way to get at inviteR (the error for that is Could not deduce (MonadLift (GHandler Auth m) (GWidget s m))).
The function addSubWidget should be able to help you.

Basic HTTP Auth in Yesod

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.

Resources