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
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!
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 184.108.40.206 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
- 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!
You may have realized
fromIntegerwould have a type signature
Integer -> ain the class declaration. So how does Haskell know what type we actually want to get? In this case, it knows
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
fromIntegerand input of
showmight be any instance of both
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
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
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.
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:
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
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
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
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.
Result decoder converters the entire result of an SQL query to a certain type. It is defined in terms of
Row decoder on the other hand will convert a single row. It is defined with
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
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
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
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
taskDecoder :: Hasql.Decoders.Row Task taskDecoder = Task <$> stringDecoder_row <*> taskStatusDecoder_row
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
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.