Setting up the database

Now that we have set up a very primitive stateless server, the next step in any regular tutorial would be to store the state in memory and do some interactions with html. That way it looks like you’re getting results faster. But no! This is Haskell for madmen, not Python for fools!

We will use a database, which is most likely what you’ll want to be doing in a production setting anyway. Docker lets us run a PostgreSQL instance in a container. Create <project root>/db/Dockerfile with the following:

FROM postgres:latest

ENV POSTGRES_USER "Haskell-student"
ENV POSTGRES_PASSWORD "Why-are-you-putting-credentials-in-code?-You-absolute-potato!"

Obviously we wouldn’t usually put credentials in our code but we’ll do so for now. Going over the right ways to store credentials is boring and out of scope of this tutorial. Generally though, you should consider anything that ever touched the code base to have leaked.

We need to do a few things to use our database and connect to it.

First, we’ll need to create a new docker network. Note that you need to be root to call docker.

docker network create haskell-for-madmen-network

note

To remove the network again once you’re done with it, use

docker network rm haskell-for-madmen-network

Then, we’ll need to build the database image:

docker build -t "haskell-for-madmen-db" ./db

Finally, we run the image once to launch the database and once more to launch psql.

docker run --network haskell-for-madmen-network --name haskell-for-madmen-db-container -d haskell-for-madmen-db
docker run -it --rm --network haskell-for-madmen-network haskell-for-madmen-db psql -h haskell-for-madmen-db-container -U Haskell-student

Type in the password you set as environment variable (Why-are-you-putting-credentials-in-your-code?-You-absolute-potato! if you copied the code above verbatim), and you’re in!

Connecting from Haskell

Manually connecting to PostgreSQL is not what we wanted. So let’s go back to Hackage and find a PostgreSQL library. We’ll be using hasql, version 1.3.0.6 in my case. Unfortunately Hasql does not follow semver and 1.4 is not compatible with the code below.

You will need to install the postgres development library to use hasql. How you do that will vary between operating system. En Debian-based systems you will need the libpq-dev package. For our CI pipeline we will need to add the following to .gitlab-ci.yml:

- apt-get update
- apt-get install -y libpq-dev

You could build and run your entire project inside a docker container and add the library there, much like we’re doing in CI. I haven’t done so because this is not a docker tutorial and I would like to keep non-Haskell stuff to a minimum.

If you’re not going to run your Haskell code in a container, we’ll need to expose the port of our database, which requires stopping the container that’s already running.

docker stop haskell-for-madmen-db-container
docker rm haskell-for-madmen-db-container
docker run --network haskell-for-madmen-network --name haskell-for-madmen-db-container -p 5432:5432 -d haskell-for-madmen-db

If you already have an application listening on port 5432 you’ll need to use a different input port in -p <input port>:5432.

You might want to stack build right after adding the dependency, as this one will take a while.

Finally back to Haskell, let’s look in the Connection module and import it:

import qualified Hasql.Connection

We find the functions:

• acquire :: Settings -> IO (Either ConnectionError Connection)
• release :: Connection -> IO ()
• settings :: ByteString -> Word16 -> ByteString -> ByteString -> ByteString -> Settings

So it looks like we’re going to have to declare settings before we can make a connection. We know ByteString already, but what is a Word16? The Hasql documentation tells us this should be a port. Clicking through to the documentation of Word16 tells us it’s a 16-bit integer that’s an instances a bunch of classes. If we search through the classes it implements, we will find Num with the interesting function fromInteger :: Integer -> Word16. We can use that!

note

You may have realized fromInteger would have a type signature Integer -> a in the class declaration. So how does Haskell know what type we actually want to get? In this case, it knows Hasql.Connection.settings needs a Word16, so it tries to solve the type constraints and manages to do so unambiguously. In some rare cases though, it might not be able to infer what type you actually want to use. For instance, we might write show $ fromInteger 42, but the output of fromInteger and input of show might be any instance of both Num and Show! In such cases, we need to provide the type explicitly: show $ (fromInteger 42 :: Word16)

Now we know enough to put together our connection code (leaving the database field blank for now).

connectToDB :: IO ()
connectToDB =
  let
    connectionSettings :: Hasql.Connection.Settings
    connectionSettings =
      Hasql.Connection.settings
        "localhost"
        (fromInteger 5432)
        "Haskell-student"
        "Why-are-you-putting-credentials-in-code?-You-absolute-potato!"
        ""
  in do
    connectionResult <- Hasql.Connection.acquire connectionSettings
    case connectionResult of
      Left (Just errMsg) -> error $ StrictUTF8.toString errMsg
      Left Nothing -> error "Unspecified connection error"
      Right connection -> do
        putStrLn "Acquired connection!"
        Hasql.Connection.release connection

Let’s also change someFunc to call connectToDB before starting the server.

someFunc :: IO ()
someFunc = do
  connectToDB
  run 8080 requestHandler

stack run and you should see the message Acquired connection!.

Populating the DB

We will need to populate the database to query anything. Create an init file db/docker-entrypoint-initdb.d/init.sql with the following content:

CREATE DATABASE todolists;

\connect todolists

CREATE TABLE todolist_ch5 (
  task TEXT NOT NULL,
  done BOOLEAN NOT NULL
);

INSERT INTO todolist_ch5 (
  task,
  done
)
VALUES
  ( 'create todo list', TRUE ),
  ( 'put todo list in database', TRUE ),
  ( 'invent terror drones', FALSE ),
  ( 'achieve world domination', FALSE );

Usually we’d create proper indices, but this will do for our current requirements.

We’ll also need to add the init file in our db/Dockerfile:

COPY docker-entrypoint-initdb.d/ ./docker-entrypoint-initdb.d/

And stop, remove, rebuild and restart the database container:

docker stop haskell-for-madmen-db-container
docker rm haskell-for-madmen-db-container
docker build -t "haskell-for-madmen-db" ./db
docker run --network haskell-for-madmen-network --name haskell-for-madmen-db-container -p 5432:5432 -d haskell-for-madmen-db

The base image we’ve used for our dockerfile will run any scripts in finds in ./docker-entrypoint-initdb.d/ at startup.

Feel free to use psql to check the content of the database if you wish.

Fetching data in Haskell

The inner workings of Hasql are a wee bit complicated if you’re not used to thinking with functors yet. You could try to figure it out yourself, but I expect this is still a bit too complicated if this tutorial is your first introduction to Haskell’s type classes. So here’s what we can work with:

A Statement in Hasql.Statement is a sort-of operation we can perform on the database. Statement a b can be used to fetch data of type b given data of type a.

Using Hasql.Session.statement we can create a Hasql.Session.Session from a Statement and input parameters for said statement. We can then use Hasql.Session.run with a Connection, which we already got in the code above, to get an IO action.

Think of it like this: a Statement tells us how to make a query, a Session is a query, and using a Connection we can run the query, which is an IO action.

We will need a few imports:

import qualified Hasql.Session
import qualified Hasql.Statement
import qualified Hasql.Encoders
import qualified Hasql.Decoders

Let’s start at the bottom and make a Statement that takes no arguments and returns out todo list of type [Task]. Remember that there’s no such thing in Haskell as no arguments, we use () (unit) instead.

selectTasksStatement :: Hasql.Statement.Statement () Task

The first argument to the Statement constructor is an SQL string, with input parameters replaced by $<number>. The second is an encoder. The encoder will turn out custom types into types that Hasql knows how to place in tables. Then we’ll need to pass an encoder, which does the opposite of an encoder. Finally we need to pass whether the statement should be prepared.

We’ll find encoder in Hasql.Encoders. We don’t have any parameters, so Hasql.Encoders.unit works for us.

Let’s postpone the creation of a decoder for a minute, and create our statement and session:

selectTasksSession :: Hasql.Session.Session [Task]
selectTasksSession = Hasql.Session.statement () selectTasksStatement

selectTasksStatement :: Hasql.Statement.Statement () [Task]
selectTasksStatement =
  Hasql.Statement.Statement
    "SELECT * FROM todolist_ch5"
    Hasql.Encoders.unit
    tasksDecoder
    True

tasksDecoder :: Hasql.Decoders.Result [Task]
tasksDecoder = error "Didn't actually implement decoder yet"

With our mental cache cleared, let’s focus entirely on the decoder. A Result decoder converters the entire result of an SQL query to a certain type. It is defined in terms of Row decoders. A Row decoder on the other hand will convert a single row. It is defined with Column decoders. Finally, a Column is a Value decoder with known nullability.

All our decoders are Functors (check the docs under “Instances”). This means that if we have a value of type decoder a and a function a -> b we can get a decoder b by using fmap. That’s useful for turning the BOOLEAN in SQL to a TaskStatus in our program:

boolToTaskStatus :: Bool -> TaskStatus
boolToTaskStatus True = Done
boolToTaskStatus False = NotDone

taskStatusDecoder :: Hasql.Decoders.Value TaskStatus
taskStatusDecoder = fmap boolToTaskStatus Hasql.Decoders.bool

Similarly, Hasql has a Value Text encoder but not a Value String. The implementation of sting String is now widely considered to have been a mistake, but it’s still in the default prelude and many libraries use it, Text is an improvement upon String. To convert Text to String, we’ll need the text package. Import Data.Text and use unpack, you should know the procedure by now.

stringDecoder :: Hasql.Decoders.Value String
stringDecoder = fmap Data.Text.unpack Hasql.Decoders.text

But we still need to apply the Task constructor over the task description and status. Value gives us nothing to do that! Indeed, a Value a only concerns itself with a single column, whereas a Task is stored across multiple columns. So we must create a decoder for a row instead. First we create row decoders from our value decoders:

stringDecoder_row :: Hasql.Decoders.Row String
stringDecoder_row = Hasql.Decoders.column stringDecoder

taskStatusDecoder_row :: Hasql.Decoders.Row TaskStatus
taskStatusDecoder_row = Hasql.Decoders.column taskStatusDecoder

Now Row is an instance of Applicative! Although functors allow us to use fmap to get

fmap Task stringDecoder_row :: (Functor f) => f (TaskStatus -> Task)

they don’t give us a way to combine an f (a -> b) with an f a. For applicatives, on the oher hand, we have:

 (<*>) :: f (a -> b) -> f a -> f b

so we can do fmap Task stringDecoder_row <*> taskStatusDecoder_row! We can improve readability using the <$> operator:

taskDecoder :: Hasql.Decoders.Row Task
taskDecoder = Task <$> stringDecoder_row <*> taskStatusDecoder_row

Using rowList :: Row a -> Result [a] we can now easily create the result decoder we’d wanted.

tasksDecoder = Hasql.Decoders.rowList taskDecoder

Finally, we modify our top level functions to fetch the information from the right database when we connect to the server. I’ve renamed connectToDB to fetchFromDB.

someFunc :: IO ()
someFunc = do
  run 8080 requestHandler

requestHandler :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
requestHandler request respond =
  let
    htmlPage htmlAble = UTF8.fromString $ toHTMLPage htmlAble
    response tasks = responseLBS status200 [] $ htmlPage tasks
  in
    do
      taskList <- fetchFromDB
      putStrLn "Received an HTTP request!"
      respond $ response taskList

fetchFromDB :: IO [Task]
fetchFromDB =
  let
    connectionSettings :: Hasql.Connection.Settings
    connectionSettings =
      Hasql.Connection.settings
        "localhost"
        (fromInteger 5432)
        "Haskell-student"
        "Why-are-you-putting-credentials-in-code?-You-absolute-potato!"
        "todolists"
  in do
    connectionResult <- Hasql.Connection.acquire connectionSettings
    case connectionResult of
      Left (Just errMsg) -> error $ StrictUTF8.toString errMsg
      Left Nothing -> error "Unspecified connection error"
      Right connection -> do
        queryResult <- Hasql.Session.run selectTasksSession connection
        Hasql.Connection.release connection
        case queryResult of
          Right result -> return result
          Left err -> error $ show err

And the result:

The output does not look like much for the amount of work we put in. I will discuss this issue next chapter, along with some other reflections and cleanup.

Final code for this chapter