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.

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

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.

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.

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