NOTE: This tutorial is for servant-0.4. The repository is currently set up for servant-0.5, and I’m writing a follow up blog post on it.
When people talk about why they like Haskell, the type system always comes out as a big win. Everything from inference, to refactorability, to compile-time checking. The more you can program into the type system, the more benefit you gain from it – and there have been some compelling demonstrations lately.
Servant is a fantastic example of this. Servant provides a type-level DSL for defining a webservice API. You describe the endpoints, named captures, query parameters, headers, response types, etc. The compiler is then able to verify the correctness of your code in fulfilling the API you described. Define a new route? The compiler immediately lets you know what’s missing. Change the parameters that an endpoint accepts? The compiler lets you know which endpoint function needs to change, and how.
Servant is still rather new, and there wasn’t yet an example on connecting a Servant API with a database. Persistent leverages the type system similarly, and the combination of the two makes for a compelling example on the power of Haskell.
The code for this post is available in the following GitHub repository: parsonsmatt/servant-persistent.
Main is brief – it gathers some configuration information from the environment, initializes the database resources, and runs the server.
module Main where
import Network.Wai.Handler.Warp (run)
import System.Environment (lookupEnv)
import Database.Persist.Postgresql (runSqlPool)
import Config (defaultConfig, Config(..), Environment(..), setLogger, makePool)
import Api (app)
import Models (doMigrations)
main :: IO ()
main = do
env <- lookupSetting "ENV" Development
port <- lookupSetting "PORT" 8081
pool <- makePool env
let cfg = defaultConfig { getPool = pool, getEnv = env }
logger = setLogger env
runSqlPool doMigrations pool
run port $ logger $ app cfg
lookupSetting :: Read a => String -> a -> IO a
lookupSetting env def = do
p <- lookupEnv env
return $ case p of Nothing -> def
Just a -> read a
And that’s it for the Main module!
Now, let’s dig into the neat stuff – the API definition! This is located in src/Api.hs. As usual, language pragmas and imports bring up the beginning:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Api where
import Control.Monad.Reader (ReaderT, runReaderT, lift)
import Control.Monad.Trans.Either (EitherT, left)
import Network.Wai (Application)
import Database.Persist.Postgresql (selectList, Entity(..), (==.)
, fromSqlKey)
import Data.Int (Int64)
import Servant
import Config (Config(..))
import Models -- (Person, runDb, userToPerson, EntityField(UserName))
The Servant import isn’t qualified, as it brings about 20 terms into scope, included type operators, and GHC was complaining about trying to explicitly import them. Config and Models are both internal modules to the application. The qualified imports for the Model are commented out, as the module doesn’t export the EntityField(UserName) definition and wouldn’t compile. I left the comment there to show what is being imported.
The API we’ll be describing is pretty simple: we want to be able to get a list of users, create a user, and retreive a single user by name. We’ll return them as JSON. We’ll go over each line individually to describe what’s going on here.
type PersonAPI =
"users" :> Get '[JSON] [Person]
{- scope / verb encoding return value -}
"users" indicates that this route will start with /users. :> acts to combine parts of the route. The final part of the route specifies the HTTP verb, the return content encodings, and what the request will return. So “return all users as JSON” – not too bad!
:<|> "users" :> Capture "name" String :> Get '[JSON] Person
The :<|> is an Alternative type operator. It can be read as “or”: The type of this route is either ‘get all users at /users or get a single user at /users/:name’. Capture "name" String is how we specify that we want this to be a named capture, and we’ll read it as a String. Servant has a lot of types built in, and you’re able to define your own.
:<|> "users" :> ReqBody '[JSON] Person :> Post '[JSON] Int64
Lastly, this one specifies that we’ll accept a POST request at /users. The ReqBody will accept JSON encoding of a Person, and will return an Int64.
Now that we’ve defined the API, we need to serve it. By default, Servant uses an EitherT ServantErr IO. We’d like to extend this with the Reader monad to make the database configuration available without manually threading it through all the functions that require it. A detailed description on this is available in this guide.
type AppM = ReaderT Config (EitherT ServantErr IO)
userAPI :: Proxy PersonAPI
userAPI = Proxy
readerToEither :: Config -> AppM :~> EitherT ServantErr IO
readerToEither cfg = Nat $ \x -> runReaderT x cfg
readerServer :: Config -> Server PersonAPI
readerServer cfg = enter (readerToEither cfg) server
app :: Config -> Application
app cfg = serve userAPI (readerServer cfg)
Now we’ve got something that returns a WAI Application! We’re just about ready to run this.
server :: ServerT PersonAPI AppM
server = allPersons :<|> singlePerson :<|> createPerson
We defined three routes, so we need three handler functions. And the handler functions need to be of the right type!
allPersons :: AppM [Person]
allPersons = do
users <- runDb $ selectList [] []
let people = map (\(Entity _ y) -> userToPerson y) users
return people
Persistent’s selectList here is pretty astounding at first – it’s capable of inferring the database table to query on based on the type. The first list is a list of filters, so we’re getting all of the Users out of the database. Persistent knows this because we’re mapping the function userToPerson :: User -> Person over the array. In any case, we’ve got a fairly standard Persistent query, and a return to raise it into the AppM monad.
singlePerson :: String -> AppM Person
singlePerson str = do
users <- runDb $ selectList [UserName ==. str] []
let list = map (\(Entity _ y) -> userToPerson y) users
case list of
[] -> lift $ left err404
(x:xs) -> return x
At the top, we defined the route to take a single named capture. This function uses that named capture as a parameter. We’ll select all users from the database with the same name as the capture. If the resulting list is empty, we’ll error out with a 404. Otherwise, we’ll return the first one.
This isn’t particularly elegant, but it shows how to error out of a servant request. Since our overall monad is ReaderT Config (EitherT ServantErr IO), we have to lift the call to left.
createPerson :: Person -> AppM Int64
createPerson p = do
newPerson <- runDb $ insert $ User (name p) (email p)
return $ fromSqlKey newPerson
In all of these examples, I’ve used an indirect type. User is the database model, and Person is what we’re interfacing with. If we were directly dealing with Users, then this function could be expressed as the point-free one liner:
createUser = liftM fromSqlKey . runDb . insert
And that’s it. The API is defined and ready to be served!
Config contains many of the functions used to configure the application, as well as the Config datatype that the ReaderT monad uses. I’ll skip the imports in the interest of brevity:
data Config = Config
{ getPool :: ConnectionPool
, getEnv :: Environment
}
data Environment =
Development
| Test
| Production
deriving (Eq, Show, Read)
defaultConfig :: Config
defaultConfig = Config
{ getPool = undefined
, getEnv = Development
}
Config is a simple record that we stuff into the Reader monad so we can read information from it with asks. We’ll use this with the runDb function, which is defined in Models.
Models holds the data definitions for our data types, and a few functions for running queries against the database. Persistent brings a ton of language extensions into play and uses Template Haskell extensively. For a good introduction to Persistent, see the chapter from the Yesod book. Our database model User is here:
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
User
name String
email String
deriving Show
|]
and our API data type Person is here:
data Person = Person
{ name :: String
, email :: String
} deriving (Eq, Show, Generic)
instance ToJSON Person
instance FromJSON Person
userToPerson :: User -> Person
userToPerson User{..} = Person { name = userName, email = userEmail }
Nothing too fancy! Now we just need to query the database, and we’ll be all set. The monad that our application uses is the ReaderT Config (EitherT ServantErr IO) monad stack. runSqlPool operates in IO, so we’ll need to liftIO to get it where we want it. Our connection pool is stored in the Config, so we’ll need to asks getPool to access it. runDb therefore looks like:
runDb query = do
pool <- asks getPool
liftIO $ runSqlPool query pool
This can also be written as runDb query = asks getPool >>= liftIO . runSqlPool query if you’re into one liners.
All the files are available on the Github repository. Clone the repository, get it running, and play with it. If you’d like some practice, try the following exercises:
Post model to the database definition, with a title, body, and a reference to a User that authored it. Use Persistent’s convenient json annotation to automatically derive FromJSON and ToJSON instances.users/:id/posts. After adding the route, read the type error, and see what function you need to add to the server.users/:id/posts. You’ll need to access the ReqBody and a Capture for this.FollowRelation that stores a Follower user reference and a Follows user reference.users/:id/followersusers/:id/follow that creates a FollowRelation