Introduction

This is hopefully the first blog post in many with "cookbook" style answers. If you have either questions or "recipes" to submit, please . Eventually, this content will make its way into the Yesod book.

Adding a local Javascript file

There are two main functions used to include a reference to an external Javascript file: addScript and addScriptRemote. The latter is used when you want to provide the actual URL to the script, and can be especially useful for referencing CDN-hosted libraries, such as Google-hosted jQuery.

The former function is used when you want to refer to a type-safe URL. The most common case of this is with the yesod-static package; if you want to use that, the best place to see an example usage is in the scaffolded site. Here is a minimal example using the lower-level sendFile.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
import Yesod

data Local = Local
type Handler = GHandler Local Local

mkYesod "Local" [parseRoutes|
/ RootR GET
/myfile.js MyFileJsR GET
|]

instance Yesod Local where
    approot _ = ""

getRootR = defaultLayout $ do
    addScript MyFileJsR
    addHamlet [hamlet|
<h1>HELLO WORLD!
|]

 -- type sig necessary, since sendFile is polymorphic
getMyFileJsR :: Handler ()
-- Serves "myfile.js" with text/javascript mime-type.
-- Served from /myfile.js as defined above, but your code needn't know that.
getMyFileJsR = sendFile "text/javascript" "myfile.js"

main = warpDebug 3000 Local

Virtual Hosts

Often times, we'll want to run multiple sites from a single machine, using virtual hosts. The recommended approach in general is to use a web server like Nginx to be the frontend server, and to reverse HTTP proxy to your individual sites. However, it's entirely possible to do this in 100% pure Haskell, with just a single instance running for all your sites.

To achieve this, we'll use the vhost middleware. We'll start off with some boilerplate definitions of three Yesod sites:

{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

import Yesod
import Network.Wai.Middleware.Vhost
import Network.Wai.Handler.Warp
import Network.Wai

data Site1 = Site1
data Site2 = Site2
data DefaultSite = DefaultSite

mkYesod "Site1" [parseRoutes|/ Root1 GET|]
getRoot1 = return $ RepPlain "Root1"

mkYesod "Site2" [parseRoutes|/ Root2 GET|]
getRoot2 = return $ RepPlain "Root2"

mkYesod "DefaultSite" [parseRoutes|/ RootDef GET|]
getRootDef = return $ RepPlain "RootDef"

instance Yesod Site1 where approot _ = ""
instance Yesod Site2 where approot _ = ""
instance Yesod DefaultSite where approot _ = ""

Now comes the actual virtual hosting. We want to serve Site1 from "host1", Site2 from "host2", and otherwise serve DefaultSite. In order to determine which site to use, we'll compare against the serverName record of the WAI request value. The code is very straight-forward:

main = do
   app1 <- toWaiApp Site1
   app2 <- toWaiApp Site2
   appDef <- toWaiApp DefaultSite
   run 3000 $ vhost
       [ ((==) "host1" . serverName, app1)
       , ((==) "host2" . serverName, app2)
       ] appDef

The vhost function takes two arguments: a list of pairs of predicates and applications, and a final default application. This approach works very well for just a few sites, but if you have dozens of virtual hosts, it would be more efficient to use a Map. Add the following to your import list:

import qualified Data.Map as Map

And then replace your main with:

main = do
   app1 <- toWaiApp Site1
   app2 <- toWaiApp Site2
   appDef <- toWaiApp DefaultSite
   let sites = Map.fromList
                   [ ("host1", app1)
                   , ("host2", app2)
                   ]
   run 3000 $ \req ->
       case Map.lookup (serverName req) sites of
           Nothing -> appDef req
           Just app -> app req

Yesod Proxy Server

Yesod is built on top of WAI, which in turn is built on enumerators. One of the advantages of enumerators is being able to work with streams of data, in constant space. By building on a central enumerator system, multiple libraries are able to interoperate very easily. In our case, both WAI and http-enumerator share an enumerator approach. Combined with Aristid Breitkreuz's http-types, it is much easier to get these packages to interoperate.

Unfortunately, there are still a few gotchas. If you're not familiar with enumerators, it can be difficult to get the types to work out. Yesod purposely doesn't advertise the low-level functions necessary to get things to work, since they are confusing to new users. And there's a bit of a catch with Builders versus ByteStrings. We'll step through a very simple Yesod app that proxies the Yesod homepage. We'll start with our standard language extensions:

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

Next we have our import statements. Try to follow which modules/libraries and providing different functionalities.

import Yesod hiding (Request)
import Network.HTTP.Enumerator (parseUrl, withManager, http, Request)
import Network.HTTP.Types (Status, ResponseHeaders)
import Network.Wai (Response (ResponseEnumerator))
import Data.ByteString (ByteString)
import Blaze.ByteString.Builder (Builder, fromByteString)
import Data.Enumerator (Iteratee, run_, ($$), joinI)
import qualified Data.Enumerator.List as EL

And now some simple code to create a new Yesod application with a single route and is served by Warp:

data Proxy = Proxy
type Handler = GHandler Proxy Proxy

mkYesod "Proxy" [parseRoutes|
/ RootR GET
|]

instance Yesod Proxy where
   approot _ = ""

main :: IO ()
main = warpDebug 3000 Proxy

All that's left is to define our handler function. If we look at the http-enumerator package, we'll see that there are a number of functions available for running an HTTP request. However, all of them (except simpleHttp) take a Request. So we'll start by using parseUrl to generate such a value. We'll take advantage of the IO instance of Failure by using liftIO:

getRootR :: Handler ()
getRootR = do
   req <- liftIO $ parseUrl "http://www.yesodweb.com/"

For this exercise, we're going to use the http function, which has the signature:

http :: Request IO 
     -> (Status -> ResponseHeaders -> Iteratee ByteString IO a)
     -> Manager
     -> Iteratee ByteString IO a

Alright, the Manager is simply a collection of open connections. We can generate one using withManager. And we already have our request. Now we need to do something about that second argument. But it looks strangely familiar... let's look at the definition of ResponseEnumerator from WAI:

type ResponseEnumerator a = (Status -> ResponseHeaders -> Iteratee Builder IO a) -> IO a

Interesting... it's almost identical, except for the ByteString versus Builder issue. Let's take a quick break from the definition of getRootR and define a new function, blaze, to help us out here:

blaze :: (Status -> ResponseHeaders -> Iteratee Builder IO a)
      -> Status -> ResponseHeaders -> Iteratee ByteString IO a
blaze f status headers =

First, a little side note: http-enumerator returns all of the content headers from the server, including content-encoding. This can cause a bit of a problem for clients (you know, they don't like being told their data is encoded when it isn't), so we need to strip that header out:

let notEncoding ("Content-Encoding", _) = False
        notEncoding _ = True
        headers' = filter notEncoding headers

Next, we want to get apply the status and headers to f to get our Builder Iteratee:

--builderIter :: Iteratee Builder IO a
        builderIter = f status headers'

Finally, we need to turn our Builder Iteratee into a ByteString Iteratee. Let's remember that an Iteratee is a data consumer, being fed a stream of data. In order to convert an Iteratee to receive a new stream type, we need to stick an adapter at the beginning of it, called an Enumeratee. In our case, we need to convert a stream of ByteStrings to a stream of Builders. For this, we can use Data.Enumerator.List.map and fromByteString, together with joinI and $$ for some glue:

in joinI $ EL.map fromByteString $$ builderIter

Well, now that our helper function is done, we can return to http. We need to use sendWaiResponse, which will let us send a raw WAI response from our Yesod app. And we'll want to use the ResponseEnumerator constructor for Response. So our getRootR ends up looking like:

getRootR :: Handler ()
getRootR = do
   req <- liftIO $ parseUrl "http://www.yesodweb.com/"
   sendWaiResponse $ ResponseEnumerator $ inside req

And we need inside to have a type signature of:

inside :: Request IO
       -> (Status -> ResponseHeaders -> Iteratee Builder IO a)
       -> IO a

As we mentioned before, we'll use withManager to get the manager, so our function will start off as:

inside req f = withManager $ \manager ->

And the rest is just playing with the types. We know we want to call http here, and the first argument is going to be req. f is almost the right type for the second argument to http, but it needs a little help from the blaze function. And the final argument will be manager. This gives us:

http req (blaze f) manager :: Iteratee Bytestring IO a

But we need our function to return IO a. So the last step is to actually run_ the Iteratee to produce a value. Our complete definition of inside is:

inside req f = withManager $ \manager ->
   run_ (http req (blaze f) manager)

Or in point-free style, for those inclined:

inside req f = withManager $ run_ . http req (blaze f)