A REST API with Haskell and Snap

Sid Raval

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
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.


$ cabal run -- -p 9000
$ curl -i -XPOST --data "text=Third todo" "localhost:9000/api/todos"

HTTP/1.1 201 Created
Server: Snap
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.