Layers

Yesod builds itself on top of WAI, which provides a protocol for web servers (or, more generally, handlers) and applications to communicate with each other. This is expressed through two datatypes: Request and Response. Then, an Application is defined as type:

type Application = Request
                -> (Response -> IO ResponseReceived)
                -> IO ResponseReceived

A WAI handler will take an application and run it.

Request and Response are both very low-level, trying to represent the HTTP protocol without too much embellishment. This keeps WAI as a generic tool, but also leaves out a lot of the information we need in order to implement a web framework. For example, WAI will provide us with the raw data for all request headers. But Yesod needs to parse that to get cookie information, and then parse the cookies in order to extract session information.

To deal with this dichotomy, Yesod introduces two new data types: YesodRequest and YesodResponse. YesodRequest contains a WAI Request, and also adds in such request information as cookies and session variables, and on the response side can either be a standard WAI Response, or be a higher-level representation of such a response including such things as updated session information and extra response headers. To parallel WAI’s Application, we have:

type YesodApp = YesodRequest -> ResourceT IO YesodResponse

But as a Yesod user, you never really see YesodApp. There’s another layer on top of that which you are used to dealing with: HandlerT. When you write handler functions, you need to have access to three different things:

• The YesodRequest value for the current request.

• Some basic environment information, like how to log messages or handle error conditions. This is provided by the datatype RunHandlerEnv.

• A mutable variable to keep track of updateable information, such as the headers to be returned and the user session state. This is called GHState. (I know that’s not a great name, but it’s there for historical reasons.)

So when you’re writing a handler function, you’re essentially just writing in a ReaderT transformer that has access to all of this information. The runHandler function will turn a HandlerT into a YesodApp. yesodRunner takes this a step further and converts all the way to a WAI Application.

Content

Our example above, and many others you’ve already seen, give a handler with a type of Handler Html. We’ve just described what the Handler means, but how does Yesod know how to deal with Html? The answer lies in the ToTypedContent typeclass. The relevants bit of code are:

data Content = ContentBuilder !BBuilder.Builder !(Maybe Int) -- ^ The content and optional content length.
             | ContentSource !(Source (ResourceT IO) (Flush BBuilder.Builder))
             | ContentFile !FilePath !(Maybe FilePart)
             | ContentDontEvaluate !Content
data TypedContent = TypedContent !ContentType !Content

class ToContent a where
    toContent :: a -> Content
class ToContent a => ToTypedContent a where
    toTypedContent :: a -> TypedContent

The Content datatype represents the different ways you can provide a response body. The first three mirror WAI’s representation directly. The fourth (ContentDontEvaluate) is used to indicate to Yesod whether response bodies should be fully evaluated before being returned to users. The advantage to fully evaluating is that we can provide meaningful error messages if an exception is thrown from pure code. The downside is possibly increased time and memory usage.

In any event, Yesod knows how to turn a Content into a response body. The ToContent typeclass provides a way to allow many different datatypes to be converted into response bodies. Many commonly used types are already instances of ToContent, including strict and lazy ByteString and Text, and of course Html.

TypedContent adds an extra piece of information: the content type of the value. As you might expect, there are ToTypedContent instances for a number of common datatypes, including Html, aeson’s Value (for JSON), and Text (treated as plain text).

instance ToTypedContent J.Value where
    toTypedContent v = TypedContent typeJson (toContent v)
instance ToTypedContent Html where
    toTypedContent h = TypedContent typeHtml (toContent h)
instance ToTypedContent T.Text where
    toTypedContent t = TypedContent typePlain (toContent t)

Putting this all together: a Handler is able to return any value which is an instance of ToTypedContent, and Yesod will handle turning it into an appropriate representation and setting the Content-Type response header.

Short-circuit responses

One other oddity is how short-circuiting works. For example, you can call redirect in the middle of a handler function, and the rest of the function will not be called. The mechanism we use is standard Haskell exceptions. Calling redirect just throws an exception of type HandlerContents. The runHandler function will catch any exceptions thrown and produce an appropriate response. For HandlerContents, each constructor gives a clear action to perform, be it redirecting or sending a file. For all other exception types, an error message is displayed to the user.

toWaiApp, toWaiAppPlain, and warp

Let’s assume for the moment that you have a datatype which is an instance of YesodDispatch. You’ll want to now actually run this thing somehow. To do this, we need to convert it into a WAI Application and pass it to some kind of a WAI handler/server. To start this journey, we use toWaiAppPlain. It performs any appwide initialization necessary. At the time of writing, this means allocating a logger and setting up the session backend, but more functionality may be added in the future. Using this data, we can now create a YesodRunnerEnv. And when that value is passed to yesodDispatch, we get a WAI Application.

We’re almost done. The final remaining modification is path segment cleanup. The Yesod typeclass includes a member function named cleanPath which can be used to create canonical URLs. For example, the default implementation would remove double slashes and redirect a user from /foo//bar to /foo/bar. toWaiAppPlain adds in some pre-processing to the normal WAI request by analyzing the requested path and performing cleanup/redirect as necessary.

At this point, we have a fully functional WAI Application. There are two other helper functions included. toWaiApp wraps toWaiAppPlain and additionally includes some commonly used WAI middlewares, including request logging and GZIP compression. (Please see the Haddocks for an up-to-date list.) We finally have the warp function which, as you might guess, runs your application with Warp.

Generated code

The last remaining black box is the Template Haskell generated code. This generated code is responsible for handling some of the tedious, error-prone pieces of your site. If you want to, you can write these all by hand instead. We’ll demonstrate what that translation would look like, and in the process elucidate how YesodDispatch and YesodSubDispatch work. Let’s start with a fairly typical Yesod application.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE ViewPatterns      #-}
import qualified Data.ByteString.Lazy.Char8 as L8
import           Network.HTTP.Types         (status200)
import           Network.Wai                (pathInfo, rawPathInfo,
                                             requestMethod, responseLBS)
import           Yesod

data App = App

mkYesod "App" [parseRoutes|
/only-get       OnlyGetR   GET
/any-method     AnyMethodR
/has-param/#Int HasParamR  GET
/my-subsite     MySubsiteR WaiSubsite getMySubsite
|]

instance Yesod App

getOnlyGetR :: Handler Html
getOnlyGetR = defaultLayout
    [whamlet|
        <p>Accessed via GET method
        <form method=post action=@{AnyMethodR}>
            <button>POST to /any-method
    |]

handleAnyMethodR :: Handler Html
handleAnyMethodR = do
    req <- waiRequest
    defaultLayout
        [whamlet|
            <p>In any-method, method == #{show $ requestMethod req}
        |]

getHasParamR :: Int -> Handler String
getHasParamR i = return $ show i

getMySubsite :: App -> WaiSubsite
getMySubsite _ =
    WaiSubsite app
  where
    app req sendResponse = sendResponse $ responseLBS
        status200
        [("Content-Type", "text/plain")]
        $ L8.pack $ concat
            [ "pathInfo == "
            , show $ pathInfo req
            , ", rawPathInfo == "
            , show $ rawPathInfo req
            ]

main :: IO ()
main = warp 3000 App

For completeness we’ve provided a full listing, but let’s focus on just the Template Haskell portion:

mkYesod "App" [parseRoutes|
/only-get       OnlyGetR   GET
/any-method     AnyMethodR
/has-param/#Int HasParamR  GET
/my-subsite     MySubsiteR WaiSubsite getMySubsite
|]

While this generates a few pieces of code, we only need to replicate three components to make our site work. Let’s start with the simplest: the Handler type synonym:

type Handler = HandlerT App IO

Next is the type-safe URL and its rendering function. The rendering function is allowed to generate both path segments and query string parameters. Standard Yesod sites never generate query-string parameters, but it is technically possible. And in the case of subsites, this often does happen. Notice how we handle the qs parameter for the MySubsiteR case:

instance RenderRoute App where
    data Route App = OnlyGetR
                   | AnyMethodR
                   | HasParamR Int
                   | MySubsiteR (Route WaiSubsite)
        deriving (Show, Read, Eq)

    renderRoute OnlyGetR = (["only-get"], [])
    renderRoute AnyMethodR = (["any-method"], [])
    renderRoute (HasParamR i) = (["has-param", toPathPiece i], [])
    renderRoute (MySubsiteR subRoute) =
        let (ps, qs) = renderRoute subRoute
         in ("my-subsite" : ps, qs)

You can see that there’s a fairly simple mapping from the higher-level route syntax and the RenderRoute instance. Each route becomes a constructor, each URL parameter becomes an argument to its constructor, we embed a route for the subsite, and use toPathPiece to render parameters to text.

The final component is the YesodDispatch instance. Let’s look at this in a few pieces.

instance YesodDispatch App where
    yesodDispatch env req =
        case pathInfo req of
            ["only-get"] ->
                case requestMethod req of
                    "GET" -> yesodRunner
                        getOnlyGetR
                        env
                        (Just OnlyGetR)
                        req
                    _ -> yesodRunner
                        (badMethod >> return ())
                        env
                        (Just OnlyGetR)
                        req

As described above, yesodDispatch is handed both an environment and a WAI Request value. We can now perform dispatch based on the requested path, or in WAI terms, the pathInfo. Referring back to our original high-level route syntax, we can see that our first route is going to be the single piece only-get, which we pattern match for.

Once that match has succeeded, we additionally pattern match on the request method; if it’s GET, we use the handler function getOnlyGetR. Otherwise, we want to return a 405 bad method response, and therefore use the badMethod handler. At this point, we’ve come full circle to our original handler discussion. You can see that we’re using yesodRunner to execute our handler function. As a reminder, this will take our environment and WAI Request, convert it to a YesodRequest, constructor a RunHandlerEnv, hand that to the handler function, and then convert the resulting YesodResponse into a WAI Response.

Wonderful; one down, three to go. The next one is even easier.

            ["any-method"] ->
                yesodRunner handleAnyMethodR env (Just AnyMethodR) req

Unlike OnlyGetR, AnyMethodR will work for any request method, so we don’t need to perform any further pattern matching.

            ["has-param", t] | Just i <- fromPathPiece t ->
                case requestMethod req of
                    "GET" -> yesodRunner
                        (getHasParamR i)
                        env
                        (Just $ HasParamR i)
                        req
                    _ -> yesodRunner
                        (badMethod >> return ())
                        env
                        (Just $ HasParamR i)
                        req

We add in one extra complication here: a dynamic parameter. While we used toPathPiece to render to a textual value above, we now use fromPathPiece to perform the parsing. Assuming the parse succeeds, we then follow a very similar dispatch system as was used for OnlyGetR. The prime difference is that our parameter needs to be passed to both the handler function and the route data constructor.

Next we’ll look at the subsite, which is quite different.

            ("my-subsite":rest) -> yesodSubDispatch
                YesodSubRunnerEnv
                    { ysreGetSub = getMySubsite
                    , ysreParentRunner = yesodRunner
                    , ysreToParentRoute = MySubsiteR
                    , ysreParentEnv = env
                    }
                req { pathInfo = rest }

Unlike the other pattern matches, here we just look to see if our pattern prefix matches. Any route beginning with /my-subsite should be passed off to the subsite for processing. This is where we finally get to use yesodSubDispatch. This function closely mirrors yesodDispatch. We need to construct a new environment to be passed to it. Let’s discuss the four fields:

• ysreGetSub demonstrates how to get the subsite foundation type from the master site. We provide getMySubsite, which is the function we provided in the high-level route syntax.

• ysreParentRunner provides a means of running a handler function. It may seem a bit boring to just provide yesodRunner, but by having a separate parameter we allow the construction of deeply nested subsites, which will wrap and unwrap many layers of interleaving subsites. (This is a more advanced concept which we won’t be covering in this chapter.)

• ysreToParentRoute will convert a route for the subsite into a route for the parent site. This is the purpose of the MySubsiteR constructor. This allows subsites to use functions such as getRouteToParent.

• ysreParentEnv simply passes on the initial environment, which contains a number of things the subsite may need (such as logger).

The other interesting thing is how we modify the pathInfo. This allows subsites to continue dispatching from where the parent site left off. To demonstrate how this works, see some screenshots of various requests in the following figure.

Path info in subsite

And finally, not all requests will be valid routes. For those cases, we just want to respond with a 404 not found.

            _ -> yesodRunner (notFound >> return ()) env Nothing req

Complete code

Following is the full code for the non-Template Haskell approach.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE ViewPatterns      #-}
import qualified Data.ByteString.Lazy.Char8 as L8
import           Network.HTTP.Types         (status200)
import           Network.Wai                (pathInfo, rawPathInfo,
                                             requestMethod, responseLBS)
import           Yesod
import           Yesod.Core.Types           (YesodSubRunnerEnv (..))

data App = App

instance RenderRoute App where
    data Route App = OnlyGetR
                   | AnyMethodR
                   | HasParamR Int
                   | MySubsiteR (Route WaiSubsite)
        deriving (Show, Read, Eq)

    renderRoute OnlyGetR = (["only-get"], [])
    renderRoute AnyMethodR = (["any-method"], [])
    renderRoute (HasParamR i) = (["has-param", toPathPiece i], [])
    renderRoute (MySubsiteR subRoute) =
        let (ps, qs) = renderRoute subRoute
         in ("my-subsite" : ps, qs)

type Handler = HandlerT App IO

instance Yesod App

instance YesodDispatch App where
    yesodDispatch env req =
        case pathInfo req of
            ["only-get"] ->
                case requestMethod req of
                    "GET" -> yesodRunner
                        getOnlyGetR
                        env
                        (Just OnlyGetR)
                        req
                    _ -> yesodRunner
                        (badMethod >> return ())
                        env
                        (Just OnlyGetR)
                        req
            ["any-method"] ->
                yesodRunner handleAnyMethodR env (Just AnyMethodR) req
            ["has-param", t] | Just i <- fromPathPiece t ->
                case requestMethod req of
                    "GET" -> yesodRunner
                        (getHasParamR i)
                        env
                        (Just $ HasParamR i)
                        req
                    _ -> yesodRunner
                        (badMethod >> return ())
                        env
                        (Just $ HasParamR i)
                        req
            ("my-subsite":rest) -> yesodSubDispatch
                YesodSubRunnerEnv
                    { ysreGetSub = getMySubsite
                    , ysreParentRunner = yesodRunner
                    , ysreToParentRoute = MySubsiteR
                    , ysreParentEnv = env
                    }
                req { pathInfo = rest }
            _ -> yesodRunner (notFound >> return ()) env Nothing req

getOnlyGetR :: Handler Html
getOnlyGetR = defaultLayout
    [whamlet|
        <p>Accessed via GET method
        <form method=post action=@{AnyMethodR}>
            <button>POST to /any-method
    |]

handleAnyMethodR :: Handler Html
handleAnyMethodR = do
    req <- waiRequest
    defaultLayout
        [whamlet|
            <p>In any-method, method == #{show $ requestMethod req}
        |]

getHasParamR :: Int -> Handler String
getHasParamR i = return $ show i

getMySubsite :: App -> WaiSubsite
getMySubsite _ =
    WaiSubsite app
  where
    app req sendResponse = sendResponse $ responseLBS
        status200
        [("Content-Type", "text/plain")]
        $ L8.pack $ concat
            [ "pathInfo == "
            , show $ pathInfo req
            , ", rawPathInfo == "
            , show $ rawPathInfo req
            ]

main :: IO ()
main = warp 3000 App