May 11, 2016

Mocking an Automotive Backend with Haskell and Servant: Episode 3

Jason Stolaruk

Defining our remaining endpoints

Welcome to the third post of this blog series in which we examine how the Servant library can be used to develop type safe RESTful APIs in Haskell. Specifically, our goal is to mock an automotive backend. This backend will be consumed by an app which allows the end user to view and edit a list of their vehicles, including any issues discovered by on-board diagnostics.

In the last post we managed to get a working server up and running. Thus far our API consists of the following two endpoints:

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.

In this post we’ll be rounding out our API with these remaining endpoints:

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

Having already seen how to implement the first two GET endpoints, the remaining endpoints won’t be too difficult. We’ll start by tackling both the POST request to /vehicles and the PUT request to /vehicles/n. The first step is to add two more lines to our API definition (type VehicleAPI) in our Types module:

module Types where

-- ...

import Servant (Capture, Get, JSON, Post, Put, ReqBody, (:<|>), (:>))

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

Here we have our first appearance of ReqBody (“request body”). ReqBody '[JSON] Vehicle simply declares that the endpoint expects a request body containing a vehicle object rendered in JSON.

Our next step will be writing two more handler functions for our new endpoints. Because the POST and PUT calls present the server with new data, we must first consider how to persist that data. Presently, our “database” of vehicles consists of hard-coded data in the form of an IntMap (defined in our InitData module)… How can we add to or otherwise modify that IntMap?

Because all data in Haskell is immutable*, the answer is not immediately clear. In the next post of this series, we’ll examine a relatively simple solution in which we wrap our IntMap in an IORef. For now, though, let’s keep things simple by not persisting anything.

* This statement is perhaps 99% correct. Haskell does provide certain “mutable containers;” IORef is one such construct.

Here, then, are our new handler functions:

module Server where

-- ...

server :: Server VehicleAPI
server = getAllVehicles
    :<|> getVehicleById
    :<|> postVehicle
    :<|> putVehicle
  where
    -- ...

    postVehicle :: Vehicle -> EitherT ServantErr IO Vehicle
    postVehicle = return

    putVehicle :: Int -> Vehicle -> EitherT ServantErr IO Vehicle
    putVehicle _ = return

postVehicle and putVehicle both expect a Vehicle parameter, corresponding to the JSON object sent in the request body. putVehicle additionally takes an Int parameter; this is the vehicle ID corresponding to the Capture "id" Int seen in the endpoint definition.

Our API spec dictates that the POST endpoint should respond with the newly added vehicle, while the PUT endpoint should respond with the updated vehicle. Thus our new handlers simply return the vehicle they are passed.

At this point, our code will compile and our new endpoints will “just work.” It’s really that simple! We don’t have to concern ourselves with writing code to handle malformed request bodies or erroneous URLs; Servant takes care of this for us. Thanks to strong, static typing, Servant is able to provide such functionality right out of the box.

In order to test our new endpoints, let’s add some functions to our Client module.

module Client ( tryGetAllVehicles
              , tryGetVehicleById
              , tryPostVehicle
              , tryPutVehicle ) where

-- ...

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

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

-- ...

tryPostVehicle :: Vehicle -> IO ()
tryPostVehicle = tryEndpoint . postVehicle

tryPutVehicle :: Int -> Vehicle -> IO ()
tryPutVehicle i = tryEndpoint . putVehicle i

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

That was easy! With the server up and running, let’s head over to GHCi and put our new code to work:

λ> let v = Vehicle { vin = "vin", year = 1985, model = "DeLorean", issues = [] }
λ> tryPostVehicle v
Vehicle {vin = "vin", year = 1985, model = "DeLorean", issues = []}
λ> tryPutVehicle 10 v
Vehicle {vin = "vin", year = 1985, model = "DeLorean", issues = []}

Great! Our final two endpoints are:

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.

To keep things interesting, let’s add some extra functionality to our GET endpoint: the server will optionally sort issues by either their IssueType or Priority. Recall the following data type definitions from our Types module:

data Issue = Issue { issueType :: IssueType
                   , priority  :: Priority } deriving (Eq, Generic, Show)

data IssueType = Battery
               | Brakes
               | Electrical deriving (Eq, Generic, Show, Ord)

data Priority = High | Med | Low deriving (Eq, Generic, Show, Ord)

As we’ll be doing some sorting, those Ord instances are going to come in handy.

We’ll add to our URL an optional “query parameter” named sortBy, such that the URL will look like http://localhost:8081/vehicles/issues/1?sortBy=x, where x is either the string type or the string priority.

In our Types module, we’ll import QueryParam, FromText(..), and ToText(..) from the Servant package, and add the following lines to our API definition:

:<|> "vehicles" :> "issues" :> Capture "id" Int :> QueryParam "sortBy" SortBy :> Get '[JSON] [Issue]
  :<|> "vehicles" :> "issues" :> Capture "id" Int :> ReqBody '[JSON] [Issue]    :> Put '[JSON] [Issue]

As you might guess, SortBy is actually a new data type that we must define:

data SortBy = ByType | ByPriority

For the query parameter mechanism to work, Servant requires the following instance declarations:

instance FromText SortBy where
  fromText "type"     = Just ByType -- Maybe is used because the query parameter is optional.
  fromText "priority" = Just ByPriority
  fromText _          = Nothing

instance ToText SortBy where
  toText ByType     = "type"
  toText ByPriority = "priority"

Naturally, our handler function will take care of the sorting:

module Server where

import Data.List (sortBy)
import Data.Ord (comparing)

-- ...

server :: Server VehicleAPI
server = getAllVehicles
    :<|> getVehicleById
    :<|> postVehicle
    :<|> putVehicle
    -----
    :<|> getIssuesById
    :<|> putIssues
  where
    -- ...

    getIssuesById :: Int -> Maybe SortBy -> EitherT ServantErr IO [Issue]
    getIssuesById i msb = do
        unsorted <- issues <$> getVehicleById i -- "issues" is a field of record type Vehicle.
        return . maybe unsorted (sortIssues unsorted) $ msb
      where
        sortIssues :: [Issue] -> SortBy -> [Issue]
        sortIssues is sb = case sb of ByType     -> sortHelper issueType is
                                      ByPriority -> sortHelper priority  is

        sortHelper :: (Ord a) => (Issue -> a) -> [Issue] -> [Issue]
        sortHelper = sortBy . comparing

    putIssues :: Int -> [Issue] -> EitherT ServantErr IO [Issue]
    putIssues _ = return -- We'll deal with persisting the issues later.

Finally, let’s add two functions to our Client module:

tryGetIssuesById :: Int -> Maybe SortBy -> IO ()
tryGetIssuesById i = tryEndpoint . getIssuesById i

tryPutIssues :: Int -> [Issue] -> IO ()
tryPutIssues i = tryEndpoint . putIssues i

Here is an illustration of tryGetIssuesById and tryPutIssues in action:

λ> tryGetIssuesById 1 Nothing -- Effectively omit the "sortBy" query parameter.
[Issue {issueType = Battery, priority = Low},Issue {issueType = Electrical, priority = High},Issue {issueType = Brakes, priority = Med}]

λ> tryGetIssuesById 1 . Just $ ByType -- Should be ordered Battery, Brakes, Electrical.
[Issue {issueType = Battery, priority = Low},Issue {issueType = Brakes, priority = Med},Issue {issueType = Electrical, priority = High}]

λ> tryGetIssuesById 1 . Just $ ByPriority -- Should be ordered High, Med, Low.
[Issue {issueType = Electrical, priority = High},Issue {issueType = Brakes, priority = Med},Issue {issueType = Battery, priority = Low}]

λ> tryPutIssues 0 [ Issue Battery High, Issue Brakes Low ] -- Add issues where there were none (vehicle 0).
[Issue {issueType = Battery, priority = High},Issue {issueType = Brakes, priority = Low}]

That’s all for now. In the next post, we’ll improve the server substantially by persisting our vehicle data across API calls.

Mocking an Automotive Backend with Haskell and Servant: Episode 3

Jason Stolaruk

Defining our remaining endpoints

Digital innovation for the ambitious.