We’ll be at Google Cloud Next ’24 in Las Vegas, April 9-11

Back to top
Mocking an Automotive Backend with Haskell and Servant: Episode 2

Defining our first endpoints

Read Episode 1

In the first post of this series, we outlined the high-level features of Servant and introduced our goal of mocking an automotive backend. In this post, we’ll begin a more technical discussion regarding the shape of our RESTful API and how to implement it using Servant.

Let’s imagine that the client-side app will allow the end user to view a list of their vehicles, along with a report of any issues raised by the on-board vehicle diagnostics. There will also be functionality to add new vehicles and modify existing ones. Here, then, are the endpoints we’ll be mocking:

  • Send a GET to /vehicles/all to get an array containing all the user’s vehicles.
  • Send a GET to /vehicles/n, where n is an integer ID, to get vehicle n.
  • Send a POST to /vehicles to add a new vehicle. The server will assign an ID to the new vehicle, and respond with the newly added vehicle.
  • Send a PUT to /vehicles/n to modify the existing vehicle n. The server will respond with the updated vehicle.

In addition, the following two endpoints are specifically concerned with the diagnostic issues for a given vehicle:

  • Send a GET to /vehicles/issues/n to get an array of issues for vehicle n.
  • Send a PUT to /vehicles/issues/n to modify vehicle n‘s issues. The server will respond with the updated issue list.

In Servant, endpoints are defined in terms of the Haskell data types they work with. This thoroughly bakes type safety into our services; as you’ll soon see, it’s one of the most attractive features of Servant. Our first step, then, is to define our data types. We’ll put all our type definitions into their own module.

The GHC extensions listed at the top are required by Servant and Aeson. The Aeson library will take care of JSON serialization for us; the server we’re mocking likes to deal with JSON data (and so do we, because Aeson is truly a breeze). So, while we’re at it, let’s add the following instance declarations required by Aeson:

instance FromJSON Issue
instance FromJSON IssueType
instance FromJSON Priority
instance FromJSON Vehicle
-- Depending on the version of aeson used, you may not need these "where" blocks.
instance ToJSON   Issue     where
  toJSON = genericToJSON defaultOptions
instance ToJSON   IssueType where
  toJSON = genericToJSON defaultOptions
instance ToJSON   Priority  where
  toJSON = genericToJSON defaultOptions
instance ToJSON   Vehicle   where
  toJSON = genericToJSON defaultOptions

And that’s that! Now that we have our data types, we can jump right into defining our API, starting with the /vehicles/all endpoint:

type VehicleAPI = "vehicles" :> "all" :> Get '[JSON] [Vehicle]

Curiously, our API definition takes the form of a type synonym, in which an operator – (:>) – appears twice.

The TypeOperators extension allows us to use operators as type constructors in a type declaration. Indeed, (:>) is a type constructor, just like Maybe is a type constructor (recall that Just, on the other hand, is a value constructor aka data constructor).

Furthermore, the DataKinds extension allows us to use string constants (here, "vehicles" and "all") in a type declaration.

Putting it simply, the (:>) operator combines the distinct sections of a single endpoint definition. "vehicles" :> "all" corresponds to the /vehicles/all part of our URL. Get '[JSON] [Vehicle] declares that 1) this endpoint expects a GET request, 2) the server will return a list of vehicles, and 3) the vehicle list will be rendered in JSON.

Now that we have our first endpoint, let’s add another. We’ll simply append VehicleAPI with the definition of our next endpoint:

type VehicleAPI =
       "vehicles" :> "all"            :> Get '[JSON] [Vehicle]
  :<|> "vehicles" :> Capture "id" Int :> Get '[JSON] Vehicle

The (:<|>) operator combines multiple endpoints into a single API definition. It’s all quite straightforward, and we get to enjoy coding in a highly declarative style (after all, we’re just defining a type here).

Recall that our second endpoint has the shape /vehicles/n, where n is a vehicle’s integer ID: thus we have Capture "id" Int. "id" could be any string we choose; Servant’s documentation- and JavaScript-generation features will utilize this string (beyond that, you can simply think of it as a “placeholder value”).

Also notice that here we have Vehicle as opposed to [Vehicle]. This time we won’t return all the user’s vehicles, just the one with the specified ID.

_About `servant-mock`:_

The `mock` function from [the `servant-mock` package](https://hackage.haskell.org/package/servant-mock-0.7/docs/Servant-Mock.html) makes it incredibly easy to quickly roll out a working server. All you need to do is 1) provide it with your API type (such as our `VehicleAPI` above), and 2) make sure that the types returned by your endpoints instantiate the `Arbitrary` typeclass from [`QuickCheck`](https://hackage.haskell.org/package/QuickCheck-2.8.2/docs/Test-QuickCheck.html). The server generated by `Servant.Mock.mock` will simply return random data in response to a request. The way in which you instantiate `Arbitrary` determines how the random data is generated. Any input provided in a request (captures, query parameters, request bodies, etc.) is simply ignored.

If randomized response data is enough to meet your needs, then I highly suggest you check out `servant-mock`. In this blog series I’ll show you how to roll out a more sophisticated server that processes and appropriately responds to the information it receives in a request, and whose data is persisted across calls.

I won’t be mentioning `servant-mock` again, but [the complete code for our automotive API](https://github.com/jasonstolaruk/auto-back-end) includes a function named `runMock`, in module `Main`, which starts a server generated by `Servant.Mock.mock`. If you’re interested, consider diving into the code and seeing how it’s done.

Our next step will be writing handler code for each of our endpoints (by “handler code,” we mean the code that is invoked when a client hits a particular endpoint). But before we do that, we need to hard-code some vehicle data for the server to serve up. Since each vehicle has a unique integer ID, putting our vehicles in an IntMap sounds like a fine idea. We’ll place our IntMap definition in its own module.

{-# LANGUAGE OverloadedStrings #-}

module InitData (vehicleTbl) where

import Types

import qualified Data.IntMap.Lazy as IM (IntMap, fromList)


vehicles :: [Vehicle]
vehicles = [ Vehicle "vin0" 2016 "M. Plus" []
           , Vehicle "vin1" 2015 "Void"    [ Issue Battery    Low
                                           , Issue Electrical High
                                           , Issue Brakes     Med ]
           , Vehicle "vin2" 2014 "Pure"    [] ]

vehicleTbl :: IM.IntMap Vehicle
vehicleTbl = IM.fromList . zip [0..] $ vehicles

And here is our handler code, also in its own module:

{-# LANGUAGE OverloadedStrings #-}

module Server where

import InitData
import Types

import Control.Monad.Trans.Either (EitherT, left)
import qualified Data.IntMap.Lazy as IM (elems, lookup)
import Servant ((:<|>)(..), Proxy(..), Server, ServantErr, err404, errBody)


vehicleAPI :: Proxy VehicleAPI -- Just some required boilerplate.
vehicleAPI = Proxy


server :: Server VehicleAPI
server = getAllVehicles
    :<|> getVehicleById
  where
    getAllVehicles :: EitherT ServantErr IO [Vehicle]
    getAllVehicles = return . IM.elems $ vehicleTbl

    getVehicleById :: Int -> EitherT ServantErr IO Vehicle
    getVehicleById = maybe notFound return . (`IM.lookup` vehicleTbl)
      where
        notFound = left err404 { errBody = "Vehicle ID not found." }

The (:<|>) operator has made an appearance once again. We’ve already seen how it combines endpoints; here it combines handlers (one for each endpoint).

Our handler functions are inside an EitherT monad transformer. If you aren’t familiar with how monad transformers work, the following crash course ought to go a long way.

In this case, we want to utilize the Either monad, which is defined like so:

instance Monad (Either e) where
    return = Right
    Left  l >>= f = Left l
    Right r >>= f = f r

The Either monad provides a nice mechanism for signaling an error; just use Left. Right 5 >>= x -> return (x + 100) yields Right 105, while Left "error msg" >>= x -> return (x + 100) yields Left "error msg".

The problem is, we’d like to be able to do I/O inside the Either monad. Although we’re not doing any I/O in the two handlers we have now, the need for I/O should be apparent enough (imagine, for example, a scenario in which our vehicle data must be fetched from an external database).

The solution is to stack the Either monad on top of the IO monad. This is precisely what the Either monad transformer (EitherT) does.

The Control.Monad.Trans.Either package exports a right function (analogous to the Right value constructor and also, in this case, return) and a left function (analogous to Left). Now we have:

right 5 >>= \x -> return (x + 100)          :: EitherT String IO Int
left "error msg" >>= \x -> return (x + 100) :: EitherT String IO Int

If you enter the above expressions into GHCi, you’ll get an ugly error message about the lack of a Show instance for IO (Either String Int). We can work around this using runEitherT. runEitherT will pull the Either value out of the monad stack.

λ> runEitherT $ right 5 >>= \x -> return (x + 100)
Right 105
λ> runEitherT $ left "error msg" >>= \x -> return (x + 100)
Left "error msg"

We haven’t seen anything terribly impressive yet, but so far so good. What, then, about IO? Well, all IO operations in the transformer stack must be “lifted.” This is easily accomplished with the liftIO function from Control.Monad.IO.Class. Check this out:

λ> runEitherT $ right 5 >>= \x -> let y = x + 100 in (liftIO . putStrLn . show $ y) >> return y
105
Right 105

This expression yields the same result we saw previously – Right 105 – but we also have the side effect of printing “105” to the screen! Very nice.

Enough about monad transformers and EitherT. Let’s return to our handler functions:

server :: Server VehicleAPI
server = getAllVehicles
    :<|> getVehicleById
  where
    getAllVehicles :: EitherT ServantErr IO [Vehicle]
    getAllVehicles = return . IM.elems $ vehicleTbl

    getVehicleById :: Int -> EitherT ServantErr IO Vehicle
    getVehicleById = maybe notFound return . (`IM.lookup` vehicleTbl)
      where
        notFound = left err404 { errBody = "Vehicle ID not found." }

ServantErr is our “left” type. It’s also a record type, errBody being one of its fields. err404 is simply a helper function that builds a ServantErr for us.

Notice how getVehicleById expects a parameter of type Int. This is the Int from Capture "id" Int and the n from /vehicles/n. Cool, eh?

Now that we’ve defined both our API and our handlers, we can roll out a working server with just a few more lines of code:

module Main (main) where

import Server

import Network.Wai (Application) -- Servant runs on top of Wai/Warp.
import Network.Wai.Handler.Warp (run)
import Servant.Server (serve)

main :: IO ()
main = run 8081 app

app :: Application
app = serve vehicleAPI server

Run main, and your PC (address localhost) will start listening for connections on port 8081. Then, execute curl http://localhost:8081/vehicles/all in a shell, and this is what you’ll get:

[{
    "year": 2016,
    "model": "M. Plus",
    "issues": [],
    "vin": "vin0"
}, {
    "year": 2015,
    "model": "Void",
    "issues": [{
        "priority": "Low",
        "issueType": "Battery"
    }, {
        "priority": "High",
        "issueType": "Electrical"
    }, {
        "priority": "Med",
        "issueType": "Brakes"
    }],
    "vin": "vin1"
}, {
    "year": 2014,
    "model": "Pure",
    "issues": [],
    "vin": "vin2"
}]

curl http://localhost:8081/vehicles/0 gives us:

{
    "year": 2016,
    "model": "M. Plus",
    "issues": [],
    "vin": "vin0"
}

curl http://localhost:8081/vehicles/100 responds with Vehicle ID not found, while curl http://localhost:8081/vehicles/blah and curl http://localhost:8081/blah simply report not found.

curl is fine, but we can do better. As mentioned in the first post of this series, Servant makes it exceptionally easy to write code that interacts with your endpoints, from the standpoint of a client. Let’s see how that works!

{-# LANGUAGE OverloadedStrings #-}

module Client ( tryGetAllVehicles
              , tryGetVehicleById ) where

import Server
import Types

import Control.Monad.Trans.Either (EitherT, runEitherT)
import Data.Monoid ((<>))
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.IO as T
import Servant ((:<|>)(..))
import Servant.Client (BaseUrl(..), Scheme(..), ServantError, client)

getAllVehicles ::        EitherT ServantError IO [Vehicle]
getVehicleById :: Int -> EitherT ServantError IO Vehicle

( getAllVehicles :<|>
  getVehicleById ) = client vehicleAPI host
  where
    host = BaseUrl Http "localhost" 8081

tryGetAllVehicles :: IO ()
tryGetAllVehicles = tryEndpoint getAllVehicles

tryGetVehicleById :: Int -> IO ()
tryGetVehicleById = tryEndpoint . getVehicleById

tryEndpoint :: (Show a) => EitherT ServantError IO a -> IO ()
tryEndpoint f = do
    res <- runEitherT f
    case res of Left  err -> T.putStrLn $ "Error: " <> T.pack (show err)
                Right x   -> T.putStrLn . T.pack . show $ x

We see getAllVehicles and getVehicleById again, but these are different from the functions of the same name defined in our Server module. Here we are once again in an entirely different module (Client).

To try out these functions, you’ll need to start two GHCi sessions. In first, run main; in the second, invoke tryGetAllVehicles and tryGetVehicleById as you wish. tryGetAllVehicles will yield the same result as curl http://localhost:8081/vehicles/all, while tryGetVehicleById 0 will yield the same result as curl http://localhost:8081/vehicles/0.

You may be wondering, “Where’s the rest of the code for the Client module?” The code is indeed concise. Notice how the client function references vehicleAPI from our Server module, which in turn references our API definition (type VehicleAPI) from our Types module. Given this, Servant already knows all it needs to know. Thanks to the magic of types, writing code to hit our endpoints could hardly be easier.

I won’t go into further detail regarding our Client module, as it is fairly self-explanatory.

That’s it for this blog post. In our next post, we’ll see how to implement our remaining endpoints, including how to handle POST and PUT requests.

Read Episode 1