Singpolyma

Archive for September, 2013

Archive for September, 2013

Making A Website With Haskell

Posted on

This is a guide to building simple webapps using Haskell (modelled after this article on a different framework). We will use:

  • WAI (Web Application Interface, and various utilty packages) for the backend
  • mustache2hs for templating
  • sqlite-simple for database access

Getting set up

There is a very useful utility for building Haskell called Cabal, which will allow you to track which versions of which dependencies you are using, and will tell you if they are not properly installed, etc. Create a project.cabal config file, like so:

name:            project
version:         0.1.0
cabal-version:   >= 1.8
category:        Web
copyright:       © 2013 Your Name
author:          Your Name <youremail@example.com>
maintainer:      Your Name <youremail@example.com>
stability:       experimental
synopsis:        My awesome todo-list app
homepage:        http://github.com/yourName/repoName
build-type:      Simple
description:
        A longer description of my awesome app

executable Main
        main-is: Main.hs

        build-depends:
                base == 4.*,
                http-types,
                wai,
                wai-util,
                wai-dispatch,
                yesod-routes,
                warp,
                text,
                path-pieces

source-repository head
        type:     git
        location: git://github.com/yourName/repoName.git

cabal configure will check that you have everything installed cabal build will build your project.

You may want to set up a Makefile, like so:

GHCFLAGS=-Wall -fno-warn-name-shadowing -XHaskell98 -O2

dist/build/project/Main: project.cabal dist/setup-config Main.hs
    cabal build --ghc-options="$(GHCFLAGS)"

dist/setup-config: project.cabal
    cabal configure

.PHONY: clean

clean:
    find -name '*.o' -o -name '*.hi' | xargs $(RM)
    $(RM) -r dist dist-ghc

Hello World

Save this as Main.hs:

module Main (main) where

import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types (ok200)
import Network.Wai.Util (string)

main = run 3000 (\_ -> string ok200 [] "Hello, World!")

Now make and run it:

cabal build
dist/build/bin/Main

Go to http://localhost:3000 and you should see your Haskell site!

Routing

Our previous app gave the same response to every request. We will use the routeGenerator utility to create fast, compiled routes from a simple syntax:

cabal install route-generator

Add the following rule to your Makefile:

Routes.hs: routes
    routeGenerator -r -m Application $< > $@

You will want a file named routes with your routing information in it.

The router supports any possible HTTP method:

GET / => homePage
POST / => postPost
PURCHASE / => buyTheThing

Where the names on the right-hand side are the names of functions in your Application.hs module.

You can also capture parameters:

GET /post/: => showPost

Here’s an example of an Application.hs with handlers for these routes:

module Application where

import Network.HTTP.Types (ok200, notFound404)
import Network.Wai (Application)
import Network.Wai.Util (string)

homePage :: Application
homePage _ = string ok200 [] "Hello, World!"

postPost _ = string ok200 [] "You posted!"

buyTheThing _ = string ok200 [] "Bought it!"

showPost arg _ = string ok200 [] arg

on404 _ = string notFound404 [] "Not found"

And run the whole thing, with the proper 404, like so:

module Main (main) where

import Network.Wai.Handler.Warp (run)
import Network.Wai.Dispatch (dispatch)
import Application
import Routes

main = run 3000 $ dispatch on404 routes

Headers

Get a header:

import Network.Wai.Util (bytestring)
import Data.String (fromString)
import Data.Maybe (fromMaybe)
import Data.Monoid (mempty)

homePage req = bytestring ok200 [] (fromMaybe mempty $ lookup (fromString "User-Agent") $ requestHeaders req)

Set a header:

import Network.Wai.Util (stringHeaders')
homePage _ = string ok200 (stringHeaders' [("Content-Type", "text/calendar")]) "Not a calendar ;)"

Content types

Respond with the appropriate content type:

import Network.Wai.Util (handleAcceptTypes, string, json)

homePage = handleAcceptTypes [
        ("text/plain", string ok200 [] "You asked for text, here it is.")
        ("application/json", json ok200 [] ["A JSON", "array"])
    ]

Templates

There are many good templating systems. My favourites are blaze-html and mustache2hs, because:

  1. They give you some type-checking of your templates at compile time.
  2. They are super fast.

To use mustache2hs, first install it:

cabal install mustache2hs

You will need a module to contain the records that you will render out in your template (Records.hs):

module Records where

data HomePageData = HomePageData {
        title :: String,
        username :: Maybe String
    }

And an actual template to render (homePageView.mustache):

<html>
    <head>
        <title>{{title}}</title>
    </head>
    <body>
        <h1>{{title}}</h1>

        {{#username}}
            Welcome, {{username}}!
        {{/username}}
    </body>
</html>

Set up your Makefile to generate the code:

MustacheTemplates.hs: Records.hs homePageView.mustache
    mustache2hs -m Records.hs homePageView.mustache HomePageData > $@

And actually render it out:

import Network.Wai.Util (stringHeaders', textBuilder)
import MustacheTemplates

htmlEscape :: String -> String
htmlEscape = concatMap escChar
    where
    escChar '&' = "&amp;"
    escChar '"' = "&quot;"
    escChar '<' = "&lt;"
    escChar '>' = "&gt;"
    escChar c   = [c]

homePage _ = textBuilder ok200
    (stringHeaders' [("Content-Type", "text/html; charset=utf-8")])
    (homePageView htmlEscape $ HomePageData "My Title" Nothing)

Logging Requests

If you want to see a log of all requests on standard out, you’ll need to change Main.hs to use a middleware:

import Network.Wai.Middleware.RequestLogger (logStdoutDev)

main = run 3000 $ logStdoutDev $ dispatch on404 routes

Serving Static Content

If you want to serve a directory of static content alongside your app, you can use a fallback mechanisms from the wai-app-static package:

import Network.Wai.Application.Static (staticApp, defaultWebAppSettings)
import Filesystem (getWorkingDirectory)

staticRoot = staticApp . defaultWebAppSettings

main = do
    cwd <- getWorkingDirectory
    run 3000 $ dispatch (staticRoot cwd) routes

Or alternately use the middleware from wai-middleware-static:

import Network.Wai.Middleware.Static (static)

main = run 3000 $ static $ dispatch on404 routes

Sessions

Some apps need a way to store data between requests using cookies. wai-session is a package that provides a generic way of doing this, and has existing backends for in-memory storage, encrypted cookies, and tokyocabinet. The wai-session-clientsession package contains the backend for encrypted cookies:

module Main where

import Data.Default (def)
import Data.Maybe (fromMaybe)
import Data.String (fromString)
import qualified Data.Vault as Vault

import Network.Wai
import Network.Wai.Util (string)
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types (ok200)
import Control.Monad.Trans.Resource (ResourceT)

import Web.ClientSession (getDefaultKey)
import Network.Wai.Session (withSession, Session)
import Network.Wai.Session.ClientSession (clientsessionStore)

app session env = do
    u <- sessionLookup "u"
    sessionInsert "u" (show $ pathInfo env)
    string ok200 [] $ fromMaybe "Nothing" u
    where
    Just (sessionLookup, sessionInsert) = Vault.lookup session (vault env)

main = do
    session <- Vault.newKey
    store <- fmap clientsessionStore getDefaultKey
    run 3000 $ withSession store (fromString "SESSION") def session $ app session

Databases

For database access, use postgresql-simple or sqlite-simple:

import Database.SQLite.Simple (open, close, query, Only(..))
import Database.SQLite.Simple.FromRow (FromRow(..))

data Post = Post {
        postTitle :: String,
        postBody :: String
    }

instance FromRow Post where
    fromRow = Post <$> field <*> field

showPost :: Int -> Application
showPost postId _ = do
    conn <- open "./production.sqlite3"
    [post] <- query conn "SELECT * FROM posts WHERE post_id = ?" (Only postId)
    string ok200 [] (postTitle post)
    close conn

Of course, you shouldn’t probably re-connect on every request. Change your Makefile to have the router pass an argument through:

Routes.hs: routes
    routeGenerator -r -n 1 -m Application $< > $@

And do the connection from Main.hs:

import Database.SQLite.Simple (open, close)

main = do
    conn <- open "./production.sqlite3"
    run 3000 $ dispatch on404 (routes conn)
    close conn

And then you can use the connection:

showPost :: Connection -> Int -> Application
showPost conn postId _ = do
    [post] <- query conn "SELECT * FROM posts WHERE post_id = ?" (Only postId)
    string ok200 [] (postTitle post)

Deploying to Heroku

Deploying to Heroku is easy with the heroku buildpack.

First, our hello world app needs to change slightly. Heroku tells us what port to run on with the PORT env variable:

module Main (main) where

import System.Environment (getEnv)
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types (ok200)
import Network.Wai.Util (string)

main = do
    port <- fmap read $ getEnv "PORT"
    run port $ string ok200 [] "Hello, World!"

Then add a Procfile in your root dir to tell Heroku how to start your app:

web: ./dist/build/project/Main

And add a Setup.hs to build your app:

import Distribution.Simple
main = defaultMain

Then, assuming your project is a git repo:

heroku create --stack=cedar --buildpack https://github.com/pufuwozu/heroku-buildpack-haskell.git
git push heroku master