Building a web application in Haskell may seem like a daunting task, but it doesn’t have to be: thanks to the authors of the Snap Framework, web development in Haskell can be fun and eye-opening! Let’s build a simple RESTful JSON API using Snap.
Moderate familiarity with the Haskell language is assumed – this guide will not go through basic Haskell syntax or setup, and you’re expected to look at documentation while reading this guide.
The code snippets start with a comment that notes what file they’re editing. Each snippet only shows the added lines to that file. I recommend glancing at each file while reading the snippet, so the previously defined values are apparent.
Hover over any linked function to see it’s type signature.
Getting set up
We’ve made a git repository that you can clone, so we’re starting off on the same page. For reference, the author is using Cabal v1.22.0.0 and GHC v7.8.4. Run the following:
git clone git@github.com:thoughtbot/snap-api-tutorial.git
cd snap-api-tutorial
git checkout baseline
cabal sandbox init
cabal install snap
cabal install --dependencies-only
The API snaplet
A snaplet is a composable piece of a Snap application. Snap applications are
built by nesting snaplets. Indeed, if you take a peek at Application.hs
you’ll see the application initializer app is itself the result of a
makeSnaplet function.
We’re going to build our own snaplet called Api. This snaplet will be
responsible for our top level /api namespace.  We’ll set a couple language
extensions, import required modules, and define our Api datatype. Then we’ll
define the initializer for our snaplet.
-- new file: src/api/Core.hs
{-# LANGUAGE OverloadedStrings #-}
module Api.Core where
import Snap.Snaplet
data Api = Api
apiInit :: SnapletInit b Api
apiInit = makeSnaplet "api" "Core Api" Nothing $ return Api
Note that the type apiInit :: SnapletInit b Api could have been
apiInit :: SnapletInit App Api. By using b instead of App, we’re telling
Snap that our Api snaplet can be nested in any base application, not just
App. This is the root of snaplet composability.
Right now our snaplet exists in isolation – we haven’t nested it within
our top level application. We’ll begin by telling our App datatype to expect
an Api snaplet:
-- src/Application.hs
import Api.Core (Api(Api))
data App = App { _api :: Snaplet Api }
Then, we’ll nest our Api snaplet within our App snaplet, using
nestSnaplet:
nestSnaplet :: ByteString -> Lens v (Snaplet v1) -> SnapletInit b v1 -> Initializer b v (Snaplet v1)
The first argument is a root base url for the snaplet’s routes, /api in our
case. The second argument is a Lens identifying our snaplet, generated by the
makeLenses function in src/Application.hs. The last argument is the snaplet
initializer function apiInit we defined previously. Putting it to use:
-- src/Site.hs
import Api.Core (Api(Api), apiInit)
app :: SnapletInit App App
app = makeSnaplet "app" "An snaplet example application." Nothing $ do
    api <- nestSnaplet "api" api apiInit
    addRoutes routes
    return $ App api
Ok, so we’ve nested our Api snaplet. But since it has no routes, we can’t
actually see it in action. We’ll add a /api/status route that always responds
with a 200 OK.
Snap route handlers generally return a type of Handler b v (). The
Handler monad is an instance of MonadSnap, which
gives us stateful access to the HTTP request and response. All of our request
and response modification and processing will take place inside a Handler
monad. Thus, we’ll define respondOk :: Handler b Api ():
-- src/api/Core.hs
import           Snap.Core
import qualified Data.ByteString.Char8 as B
apiRoutes :: [(B.ByteString, Handler b Api ())]
apiRoutes = [("status", method GET respondOk)]
respondOk :: Handler b Api ()
respondOk = modifyResponse $ setResponseCode 200
apiInit :: SnapletInit b Api
apiInit = makeSnaplet "api" "Core Api" Nothing $ do
        addRoutes apiRoutes
        return Api
Now, let’s look at the type signatures for modifyResponse
and setResponseCode:
modifyResponse :: (MonadSnap m) => (Response -> Response) -> m ()
setResponseCode :: Int -> Response -> Response
That is, setResponseCode takes an integer and returns a Response
modifying function that we can then pass into modifyResponse. modifyResponse
will perform the response modification within our Handler monad.
Now try the following:
$ cabal run -- -p 9000
$ curl -I -XGET "localhost:9000/api/status"
HTTP/1.1 200 OK
Server: Snap 0.9.4.6
Date: ...
Transfer-Encoding: chunked
Yay! Our first response.
The todo data type
Next we’ll create a Todo data type, and provide instances that allow
it to be deserialized out of a row in PostgreSQL, and serialized into JSON for
our response. First, our data type and instances:
The FromRow typeclass will allow us to define fromRow, which
deserializes rows from PostgreSQL into Todo data structures.
The ToJSON typeclass will allow us to define toJSON, which
serializes our Todo data structure into a Value type. This type can
then be converted to JSON via the encode function.
-- new file: src/api/Types.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Api.Types where
import           Control.Applicative
import qualified Data.Text as T
import           Data.Aeson (ToJSON(toJSON), object, (.=))
import           Snap.Snaplet.PostgresqlSimple
data Todo = Todo
  { todoId   :: Int
  , todoText :: T.Text
  }
instance FromRow Todo where
  fromRow = Todo <$> field
                 <*> field
instance ToJSON Todo where
   toJSON (Todo id text) = object [ "id" .= id, "text" .= text ]
In fromRow, the number of calls to field should match the number of columns
returned in the SQL query you intend to call to retrieve the data.
The todo snaplet
Next, we’ll be nesting a Todo snaplet inside our Api snaplet. We’ll then
establish a database connection, and write GET and POST handlers for
/api/todos, allowing us to create a new todo item, and fetch all todo items.
We’ll start with the boilerplate, as before – defining our snaplet, then
nesting it inside our Api snaplet:
-- new file: src/api/services/TodoService.hs
{-# LANGUAGE OverloadedStrings #-}
module Api.Services.TodoService where
import Api.Types (Todo(Todo))
import Control.Lens (makeLenses)
import Snap.Core
import Snap.Snaplet
data TodoService = TodoService
todoServiceInit :: SnapletInit b TodoService
todoServiceInit = makeSnaplet "todos" "Todo Service" Nothing $ return TodoService
-- src/api/Core.hs
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens (makeLenses)
import Api.Services.TodoService(TodoService(TodoService), todoServiceInit)
-- ...
data Api = Api { _todoService :: Snaplet TodoService }
makeLenses ''Api
-- ...
apiInit :: SnapletInit b Api
apiInit = makeSnaplet "api" "Core Api" Nothing $ do
  ts <- nestSnaplet "todos" todoService todoServiceInit
  addRoutes apiRoutes
  return $ Api ts
Nothing new here. Now we’ll nest a PostgreSQL snaplet, provided by
snaplet-postgresql-simple, into our TodoService. This will
provide the TodoService with a connection to a database, and allow us to query
it. We’ll also import Aeson, so we can encode our responses as JSON using the
ToJSON instance we defined before.
-- src/api/services/TodoService.hs
{-# LANGUAGE TemplateHaskell -#}
{-# LANGUAGE FlexibleInstances -#}
import Control.Lens (makeLenses)
import Control.Monad.State.Class (get)
import Data.Aeson (encode)
import Snap.Snaplet.PostgresqlSimple
import qualified Data.ByteString.Char8 as B
-- ...
data TodoService = TodoService { _pg :: Snaplet Postgres }
makeLenses ''TodoService
-- ...
todoServiceInit :: SnapletInit b TodoService
todoServiceInit = makeSnaplet "todos" "Todo Service" Nothing $ do
  pg <- nestSnaplet "pg" pg pgsInit
  return $ TodoService pg
instance HasPostgres (Handler b TodoService) where
  getPostgresState = with pg get
The HasPostgres instance just gives our code some brevity, you can read about
it here.
A bit of SQL to set up our database and insert a couple rows of test data:
CREATE DATABASE snaptutorial;
CREATE TABLE todos (id SERIAL, text TEXT);
INSERT INTO todos (text) VALUES ('First todo');
INSERT INTO todos (text) VALUES ('Second todo');
Then, provide configuration to the postgres snaplet by editing the following
file appropiately:
snaplets/api/snaplets/todos/snaplets/postgresql-simple/devel.cfg.
We’re now ready for our first GET to /api/todos. We’ll fetch all the rows of
the todos table, convert them into Todo data, and then serialize them as JSON
for our response.
To retreive the data, we use the query_ function, which takes a SQL
string and returns a (monadic) array of data that implement the FromRow
typeclass:
query_ :: (HasPostgres m, FromRow r) => Query -> m [r]
Then, we’ll use writeLBS in conjunction with the previously
mentioned encode function to write a JSON string to the response
body:
writeLBS :: MonadSnap m => ByteString -> m ()
Under the hood, this function calls out to a function that
calls the modifyResponse function we saw earlier.
Put together, it looks like this:
-- src/api/services/TodoService.hs
-- ...
todoRoutes :: [(B.ByteString, Handler b TodoService ())]
todoRoutes = [("/", method GET getTodos)]
getTodos :: Handler b TodoService ()
getTodos = do
  todos <- query_ "SELECT * FROM todos"
  modifyResponse $ setHeader "Content-Type" "application/json"
  writeLBS . encode $ (todos :: [Todo])
todoServiceInit :: SnapletInit b TodoService
todoServiceInit = makeSnaplet "todos" "Todo Service" Nothing $ do
  pg <- nestSnaplet "pg" pg pgsInit
  addRoutes todoRoutes
  return $ TodoService pg
-- ...
Additionally, we set  the Content-Type header so browsers know we are sending
back JSON. Voila:
$ cabal run -- -p 9000
$ curl -XGET localhost:9000/api/todos
[{"text":"First todo","id":1}, {"text":"Second todo","id":2}]
Now, to create data, we’ll write a handler for a POST to /api/todos. This
time, we’ll get parameters from our request body, and insert them into our
database. Then we’ll respond with a 201 CREATED.
This time, we’ll get data from the POST request body via getPostParam:
getPostParam :: MonadSnap m => ByteString -> m (Maybe ByteString)
Then use execute (which is the database modifying counterpart to
query) to insert the data acquired via getPostParam into the database:
todoRoutes :: [(B.ByteString, Handler b TodoService ())]
todoRoutes = [("/", method GET getTodos)
             ,("/", method POST createTodo)]
createTodo :: Handler b TodoService ()
createTodo = do
  todoTextParam <- getPostParam "text"
  newTodo <- execute "INSERT INTO todos (text) VALUES (?)" (Only todoTextParam)
  modifyResponse $ setResponseCode 201
Here, the Only is postgresql-simple’s version of single value collections.
Voila:
$ cabal run -- -p 9000
$ curl -i -XPOST --data "text=Third todo" "localhost:9000/api/todos"
HTTP/1.1 201 Created
Server: Snap 0.9.4.6
Date: ...
Transfer-Encoding: chunked
$ psql snaptutorial
$ SELECT * FROM todos;
 id |     text
----+--------------
  1 | First todo
  2 | Second todo
  3 | Third todo
And so we have a simple REST API that can fetch and create resources! For more
on Snap, check out the Snap documentation, or visit #snapframework on
freenode.
