Using IORef for persistence
Read Episode 1
Read Episode 2
Read Episode 3
In the previous installment of this series, we added POST and PUT endpoints to our mock automotive API. The client app will use these endpoints to add/modify vehicles and diagnostic issues.
Ideally, we’d like to persist these additions and modifications. If, for example, a client posts a new vehicle and subsequently makes a GET call to /vehicles/all, we’d like the newly posted vehicle to appear in the response.
Presently, our server-side vehicle data is represented as a single IntMap containing a handful of hard-coded vehicles. Because IntMaps – like almost everything else in Haskell – are immutable, special measures must be taken to accomplish persistence across calls.
We’d like to have a single, mutable IntMap shared by each of the handler functions in our Server module. That’s not all, however; our server program is multithreaded, so we must support concurrent reads and writes of the vehicle “database.” We must take measures to prevent race conditions.
You may be surprised to hear that our server is multithreaded. It’s not immediately obvious, as the spawning of threads has been entirely abstracted away from us (it’s handled under the hood by Warp, on top of which Servant is built). We can prove that our server is indeed multithreaded, though: let’s make our getAllVehicles handler (in the Server module) print its thread ID every time it’s called.
import Control.Concurrent (myThreadId)
import Control.Monad.IO.Class (liftIO)
-- ...
getAllVehicles :: EitherT ServantErr IO [Vehicle]
getAllVehicles = do
liftIO $ print =<< myThreadId
return . IM.elems $ vehicleTblHere’s what I see on my PC after making 3 GET requests to /vehicles/all:
λ> main
ThreadId 211 (Evaluated tryGetAllVehicles in a second REPL.)
ThreadId 213 (Executed curl http://localhost:8081/vehicles/all in a shell.)
ThreadId 214 (Opened http://localhost:8081/vehicles/all in a browser.)Clearly, getAllVehicles may not always be executed by the same thread. This is a good thing — a web server that’s bombarded with thousands of requests per second will need to leverage concurrency so as to remain fast and responsive.
So, we’ve established the need for both mutability and thread safety. In such a case, a common approach in Haskell is to take one of the existing, fine-tuned, pure data structures (such as IntMap) and store it in a “mutable container.”
We’ll create a single such container, shared by all of our handler functions. The container will hold a single vehicle IntMap. The IntMap itself will remain immutable as always. When we’d like to make an update to our vehicle data, we can simply swap out the IntMap inside the container for a new one. (You may find it helpful to think of the container as a “mutable reference,” such that we can change which IntMap the reference points to.)
MVar, TVar, and IORef are all mutable containers that support thread-safe operations. IORef is a good choice for us, as IORefs are both simple and highly performant. (MVars may not perform well under high contention. TVars offer composability with Software Transactional Memory operations; however, our server is simple enough that we don’t need STM, so this feature does not interest us.)
An IORef must always contain a value; it may never be empty. Furthermore, all IORef operations take place in the IO monad.
The following short demonstration will illustrate how to use IORefs. First we create a new IORef containing a string and read its contents.
import Data.IORef (atomicModifyIORef', newIORef, readIORef)
import Data.Char (toUpper)
ioRefDemo :: IO ()
ioRefDemo = do
ref <- newIORef "hello" -- Create a new IORef ("ref") containing the string "hello".
print =<< readIORef ref -- Prints "hello".Next we’ll modify the contents of the IORef using atomicModifyIORef’. Before we see an illustration of this function’s application, some explanation is in order.
As the “atomic” in its name suggests, atomicModifyIORef’ enables us to make a thread-safe update. We can rule out race conditions simply by always using atomicModifyIORef’ to make our updates. It’s really that simple: there’s no need to explicitly acquire a lock or any of that nonsense.
atomicModifyIORef’ is the strict version of atomicModifyIORef. It’s good to use the strict version so as to avoid the buildup of thunks. (A stack overflow could occur if a large number of lazy modifications are made without ever reading the IORef.)
atomicModifyIORef’ has the following type signature:
atomicModifyIORef' :: IORef a -> (a -> (a, b)) -> IO bThe second parameter is the function used to modify the contents of the IORef. In the tuple (a, b), the first element is the new value to be stored in the IORef, while the second element is simply an auxiliary value to be returned by atomicModifyIORef’. A common pattern is to return, as the auxiliary value, the new value stored in the IORef, so that it is readily accessible to the caller.
Turning back to our demo function, we now have:
ioRefDemo :: IO ()
ioRefDemo = do
ref <- newIORef "hello"
print =<< readIORef ref
let f x = (map toUpper x, ())
atomicModifyIORef' ref f -- Update the contents of the IORef by applying "map toUpper". Return "IO ()".
print =<< readIORef ref -- Prints "HELLO".The code may be strikingly imperative, but it’s still Haskell!
That’s all you need to know to use IORef (see the docs for the full details).
Now we can add thread-safe persistence to our server with a few alterations. We’d like all our handler functions to have access to a single IORef containing our vehicle IntMap, so let’s pass in the IORef to our server function (in module Server):
server :: IORef (IM.IntMap Vehicle) -> Server VehicleAPI
server ref = getAllVehicles
-- ...The IORef will be initialized in main and passed down to server from there.
module Main (main) where
import InitData
import Server
import Types
import Data.IORef (IORef, newIORef)
import Network.Wai (Application)
import Network.Wai.Handler.Warp (run)
import qualified Data.IntMap.Lazy as IM (IntMap)
import Servant.Server (serve)
main :: IO ()
main = run 8081 . app =<< newIORef vehicleTbl
app :: IORef (IM.IntMap Vehicle) -> Application
app = serve vehicleAPI . serverNow that we have our IORef, our handler functions can be updated so as to make use of it. Here is our new Server module:
{-# LANGUAGE OverloadedStrings #-}
module Server where
import Types
import Control.Concurrent (myThreadId)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Either (EitherT, left)
import Data.IORef (IORef, atomicModifyIORef', readIORef)
import Data.List ((\\), sortBy)
import Data.Ord (comparing)
import qualified Data.IntMap.Lazy as IM (IntMap, elems, insert, keys, lookup, member)
import Servant ((:<|>)(..), Proxy(..), Server, ServantErr, err404, errBody)
vehicleAPI :: Proxy VehicleAPI
vehicleAPI = Proxy
server :: IORef (IM.IntMap Vehicle) -> Server VehicleAPI
server ref = getAllVehicles
:<|> getVehicleById
:<|> postVehicle
:<|> putVehicle
-----
:<|> getIssuesById
:<|> putIssues
where
getAllVehicles :: EitherT ServantErr IO [Vehicle]
getAllVehicles = do
liftIO $ print =<< myThreadId
IM.elems <$> liftIO (readIORef ref)
getVehicleById :: Int -> EitherT ServantErr IO Vehicle
getVehicleById i = maybe notFound return =<< IM.lookup i <$> liftIO (readIORef ref)
notFound :: EitherT ServantErr IO a
notFound = left err404 { errBody = "Vehicle ID not found." }
postVehicle :: Vehicle -> EitherT ServantErr IO Vehicle
postVehicle v = liftIO $ atomicModifyIORef' ref insertIntoTbl
where
insertIntoTbl :: IM.IntMap Vehicle -> (IM.IntMap Vehicle, Vehicle)
insertIntoTbl tbl = let newUniqueId = head . ([0..] \\) $ IM.keys tbl
tbl' = IM.insert newUniqueId v tbl
in (tbl', v)
putVehicle :: Int -> Vehicle -> EitherT ServantErr IO Vehicle
putVehicle i v = putHelper f
where
f :: IM.IntMap Vehicle -> (IM.IntMap Vehicle, Maybe Vehicle)
f tbl | i `IM.member` tbl = let tbl' = IM.insert i v tbl
in (tbl', Just v)
| otherwise = (tbl, Nothing)
putHelper :: (IM.IntMap Vehicle -> (IM.IntMap Vehicle, Maybe a)) -> EitherT ServantErr IO a
putHelper f = maybe notFound return =<< liftIO (atomicModifyIORef' ref f)
-----
getIssuesById :: Int -> Maybe SortBy -> EitherT ServantErr IO [Issue]
getIssuesById i msb = do
unsorted <- issues <$> getVehicleById i
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 i is = putHelper f
where
f :: IM.IntMap Vehicle -> (IM.IntMap Vehicle, Maybe [Issue])
f tbl = maybe (tbl, Nothing) found $ IM.lookup i tbl
where
found :: Vehicle -> (IM.IntMap Vehicle, Maybe [Issue])
found v = let v' = v { issues = is }
tbl' = IM.insert i v' tbl
in (tbl', Just is)A quick application of our client functions will prove that our server is now persisting data across calls:
λ> tryGetAllVehicles -- Show us our three hardcoded vehicles.
[Vehicle {vin = "vin0", year = 2016, model = "M. Plus", issues = []},Vehicle {vin = "vin1", year = 2015, model = "Void", issues = [Issue {issueType = Battery, priority = Low},Issue {issueType = Electrical, priority = High},Issue {issueType = Brakes, priority = Med}]},Vehicle {vin = "vin2", year = 2014, model = "Pure", issues = []}]
λ> let v = Vehicle { vin = "vin", year = 1985, model = "DeLorean", issues = [] }
λ> tryPostVehicle v -- Add a new vehicle.
Vehicle {vin = "vin", year = 1985, model = "DeLorean", issues = []}
λ> tryGetAllVehicles -- We should see a fourth vehicle.
[Vehicle {vin = "vin0", year = 2016, model = "M. Plus", issues = []},Vehicle {vin = "vin1", year = 2015, model = "Void", issues = [Issue {issueType = Battery, priority = Low},Issue {issueType = Electrical, priority = High},Issue {issueType = Brakes, priority = Med}]},Vehicle {vin = "vin2", year = 2014, model = "Pure", issues = []},Vehicle {vin = "vin", year = 1985, model = "DeLorean", issues = []}]
λ> tryPutIssues 3 [Issue Battery High] -- Add an issue to our fourth vehicle.
[Issue {issueType = Battery, priority = High}]
λ> tryGetAllVehicles
[Vehicle {vin = "vin0", year = 2016, model = "M. Plus", issues = []},Vehicle {vin = "vin1", year = 2015, model = "Void", issues = [Issue {issueType = Battery, priority = Low},Issue {issueType = Electrical, priority = High},Issue {issueType = Brakes, priority = Med}]},Vehicle {vin = "vin2", year = 2014, model = "Pure", issues = []},Vehicle {vin = "vin", year = 1985, model = "DeLorean", issues = [Issue {issueType = Battery, priority = High}]}]
@davidklaw
Add heading textAdd bold text, <Cmd+b>Add italic text, <Cmd+i>
Add a quote, <Cmd+Shift+.>Add code, <Cmd+e>Add a link, <Cmd+k>
Add a bulleted list, <Cmd+Shift+8>Add a numbered list, <Cmd+Shift+7>Add a task list, <Cmd+Shift+l>
Directly mention a user or team
Reference an issue or pull request
That’s all for now! In the fifth and final installment of this blog series, we’ll see how Servant can generate API documentation for us.