Pragmatic Haskell III: Beam Postgres DB []

Note, I no longer recommend using beam for business as ORM. Please use persistent instead. Beam is far to complicated for it’s use case. Migrations can be run with postgresql-migration for example, using the suggested migrations from persistent. I’d only recommend using beam for hobby projects or as a case study for finally tagless.

No need to read a book to use Haskell! This post will get you going with a serious web application while only sticking to the concepts that are encountered. This is a Haskell safari with as end goal a working webapp with database.

  1. Pragmatic Haskell: Simple servant web server
  2. Pragmatic Haskell II: IO Webservant
  3. Pragmatic Haskell III: Beam Postgres DB

fancy db image

Web applications need to store data. In the previous blog post we did this in a file for simplicity. Now we will use something more appropriate: A relational database. The beam library is used for this because it is closest to the “ORM” way of thinking: Model a schema, generate SQL to query that schema, and have migrations to move between different versions of that schema. Migrations are left for another post for simplicity.

For the inpatient: Resulting source

Preparation

Unfortunately this post requires us to do quite a bit of devops to get started. We need to:

  1. Install Postgres
  2. Create a user
  3. Create db
  4. Populate structure

Installing Postgres is out of the scope of this post. We sidestep using migrations for with the data_model.sql file (see sources). Use the following commands to prepare the database:

sudo -u postgres createuser -s $USER
dropdb awesome_db
createdb awesome_db
psql -f ./data_model.sql -d awesome_db

Congratulations, devops was survived. Note that using this sql file is not idiomatic to beam. The schema should be managed by beam, but getting migrations to function is currently hard (it’s a work in progress).

Creating structure

The beam library models our desired structure at type level. This is done in a separate file called DB.hs. It can be seen in the sources. With help of this code beam can inspect the definitions, and it also provides type safety for the beam sql domain specific language. In other words if the migrations work there would be a path towards bringing the database up to date with the code base, or a compile error. This is very pleasant because we get a thight feedback loop. Now let us carefully inspect that file to understand it.

Language extensions

{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE DuplicateRecordFields #-}

This looks daunting however these extensions are individually quite simple. Generally they either make nicer API’s or an easier language to use. We will go over each of them.

StandaloneDeriving

StandaloneDeriving allows us to use the derive mechanism outside of a data declaration, for example:

deriving instance Show Message

This mechanism allows deriving (automatic code generation) to be used more flexibly. In this case we want to do this because the MessageT f type constructor to derive (as f is unknown), but MessageT Identity is known so we can derive that. The GHC manual lists more possible reasons to derive like this instead of the standard method.

TypeFamilies

Type families allow us to declare data inside an instance. The Table class requires TypeFamilies to instantiate because it needs a data called primary key in it’s instance:

instance Table UserT where
    data PrimaryKey UserT f = UserId (Columnar f Int) deriving Generic
    primaryKey = UserId . _id

This example is a prime reason to use type families: It allows beam to assume the primary key exist for all tables.

The Haskell wiki goes more in depth on type families

FlexibleInstances

If we don’t enable FlexibleInstances we get the following error:

/home/jappie/projects/haskell/awesome-project-name/src/DB.hs:36:10: error:
    • Illegal instance declaration for ‘Beamable (PrimaryKey MessageT)’
        (All instance types must be of the form (T a1 ... an)
         where a1 ... an are *distinct type variables*,
         and each type variable appears at most once in the instance head.
         Use FlexibleInstances if you want to disable this.)
    • In the instance declaration for ‘Beamable (PrimaryKey MessageT)’
   |
36 | instance Beamable (PrimaryKey MessageT)
   |          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Without Flexible instances parenthesis aren’t allowed. We know the parenthesis are the problem because the following line does not get an error:

instance Beamable MessageT

MultiParamTypeClasses

If MultiParamTypeClasses is disabled an error appears:

/home/jappie/projects/haskell/awesome-project-name/src/DB.hs:65:10: error:
    • Illegal instance declaration for ‘Database be AwesomeDb’
        (Only one type can be given in an instance head.
         Use MultiParamTypeClasses if you want to allow more, or zero.)
    • In the instance declaration for ‘Database be AwesomeDb’
   |
65 | instance Database be AwesomeDb
   |          ^^^^^^^^^^^^^^^^^^^^^

Because we use two parameters for this instance (be and AwesomeDb). By default Haskell only allows one.

DeriveGeneric

DeriveGeneric was discussed in a previous blog post. In short: Generic allows for introspection of data structures using the fact any data structure can be modeled in a regular (generic) pattern.

OverloadedStrings

OverloadedStrings is probably the most common language extension. It converts string automatically, for example String -> ByteString. In our case it’s only used for connection string:

connectionString :: BS.ByteString
connectionString = "dbname=awesome_db"

In this case it inserts automatically a function String -> ByteString. Using this extension avoids tedious conversions.

DuplicateRecordFields

DuplicateRecordFields allows creation of records with the same name. For example both user and messages have an _id record. Because they have the same name, type annotations are used to determine which function is called, for example in:

instance Table UserT where
    data PrimaryKey UserT f = UserId (Columnar f Int) deriving Generic
    primaryKey = UserId . (_id :: UserT f -> C f Int)

Imports

import qualified Data.ByteString                  as BS

ByteString is required for the type signature of connection string.

import qualified Data.Text                      as Text

Text is required for the column datatype.

import           Database.Beam

We import all of beam, for convenience. This entire module is a client of beam, there is no need for explicit imports.

User table

We start with defining the structure of our user table.

data UserT f = User
                { _id     :: C f Int
                , _name   :: C f Text.Text
                , _email  :: C f Text.Text
                }
                  deriving Generic

What are these C and f‘s doing here? The C is an abbreviation for Columnar, which is a type that requires two other types to complete. In this case C is given an f, and a second argument with the actual type of the column. f is not defined, instead it’s also an argument of UserT, therefore UserT is of kind * -> *. What we know however is that this f is the same for all columns in UserT.

Now this f can be thought of as a ‘gap’ that can be filled up with anything. This gap allows the beam library to inspect the structure we have defined, and therefore create a schema out of it and hold the data of a row. The hackage page goes deeper into the definition.

type User = UserT Identity

This defines a type alias. A userT with Identity is simply a user. In this case we are filling the f with Identity, a container that exposes on function runIdentity which removes the container and does nothing with the content. This is usefull for the case where we want to have the user as a result from the database.

deriving instance Show (PrimaryKey UserT Identity)
deriving instance Show User

Implement the show function automatically for the identity case and for the primary key which will be introduced below.

instance Table UserT where
    data PrimaryKey UserT f = UserId (Columnar f Int) deriving Generic
    primaryKey = UserId . (_id :: UserT f -> C f Int)
type UserId = PrimaryKey UserT Identity -- For convenience

Here we make UserT an instance of a Table. To do this we must specify a PrimaryKey, of which we define the type in the data line. The next line tells which function must be used to access the primary key. In other words we implement the primaryKey function here by saying _id must be used for it. We use a type annotation to indicate which _id function is used. Leaving that out results in an ambigious type error.

instance Beamable UserT
instance Beamable (PrimaryKey UserT)

Beamable provides several ‘introspection routines’. We require it to create a Database out of the table. The database will be described below.

Message table

data MessageT f = Message
                { _id        :: C f Int
                , _from      :: PrimaryKey UserT f
                , _content   :: C f Text.Text
                }
                  deriving Generic
type Message = MessageT Identity
deriving instance Show (PrimaryKey MessageT Identity)
deriving instance Show Message

instance Table MessageT where
    data PrimaryKey MessageT f = MessageId (Columnar f Int) deriving Generic
    primaryKey = MessageId . (_id :: MessageT f -> C f Int)
type MessageId = PrimaryKey MessageT Identity -- For convenience

instance Beamable MessageT
instance Beamable (PrimaryKey MessageT)

The boiler plate is similar to that of User, the only new concept is the from field, which points at the user table with the primary key. Beam can make joins on this with the DSL.

Database

data AwesomeDb f = AwesomeDb
                      { _users    :: f (TableEntity UserT)
                      , _messages :: f (TableEntity MessageT) }
                        deriving Generic

This type defines the entire database. Again it provides a ‘hole’ with the f.

connectionString :: BS.ByteString
connectionString = "dbname=awesome_db"

The connectionString is required to connect to the database. One probably doesn’t want to hard code it, but for this guide hard coding is good enough.

instance Database be AwesomeDb

Here we create a beam database out of the AwesomeDB type. the be hole is reserved for a back end, which we don’t specify.

awesomeDB :: DatabaseSettings be AwesomeDb
awesomeDB = defaultDbSettings

The implementation of AwesomeDB just uses the default database settings. All structural information is already provided at type level.

Using structure

Now we have a database structure defined we can use it in Lib.hs. We have already seen most of this source file in the previous blog post, the new version can be seen in the sources.

The functionality is still the same except now we’re using a database as backend rather than a file. Just like with the previous post, the example shows both how to insert, as well as retrieve data. Let’s inspect the new changes.

messages :: Connection -> Message -> Handler [Message]
messages conn message = do 
  messages <- liftIO $

Messages will hold the resulting messages we’re to querying from the database. liftIO allows functions within the IO context (eg, interact with the world).

    PgBeam.runBeamPostgres conn $ do

Run the beam Monad with help of a connection. In other words, everything within this do block is a query for the database, and we’re explicitly using postgres to solve ambiguity.

      let user = from message

Retrieve the user from message for convenience.

      [user] <- runInsertReturningList (DB._users DB.awesomeDB) $ Beam.insertExpressions [DB.User{
            DB._userId = Beam.default_,
            DB._name = Beam.val_ (pack $ name $ user ),
            DB._email = Beam.val_ (pack $ email $ user )
        }]

the runInsertReturningList function call is quite complex. The first argument defines in which table we’re using, we want to insert something into the users table. The second argument is a list of expressions. To get the expressions we use the Beam.insertExpressions function. This is how we insert an item, in this case we only want to insert one user. We use the User constructor defined earlier in the DB.hs module to obtain a user. The fields are populated with values or a special default value.

Note that although this function is complex, if we do anything wrong we get a type error. Our code will not compile unless we do it right. This is one of the strengths of beam.

      _ <- runInsertReturningList (DB._messages DB.awesomeDB) $ Beam.insertExpressions $ [DB.Message{
            DB._messageId = Beam.default_,
            DB._from = Beam.val_ (Beam.pk user),
            DB._content = Beam.val_ (pack $ content message)
        }]

These lines insert the message into the db, linking it up with the newly inserted user trough the pk.

      Beam.runSelectReturningList $ Beam.select $ do 
        usr <- (Beam.all_ (DB._users DB.awesomeDB))
        msg <- Beam.oneToMany_ (DB._messages DB.awesomeDB) DB._from usr
        pure (msg, usr)

This query gets the resulting messages and their respective users joined together.

  pure $
    fmap (
      \(msg, usr) -> Message
        (User
          (unpack $ DB._name usr)
          (unpack $ DB._email usr))
        (unpack $ DB._content msg)
    ) messages

here we convert the database user and database message, to the ‘API’ user and ‘API’ messages. The reason we need to do this is because our database data structure does not implement toJSON. Also the database structure has extra information such as the primary key which we may want to hide from API clients.

Execute!

To run the program we use:

   stack build
   stack exec webservice

To test it a simple curl request was made:

   curl --header "Content-Type: application/json" -v --data '{"from":{"email":"d","name":"xyz"}, "content": "does it word?"}' http://127.0.0.1:6868/message/

We can inspect the database with postgres

   psql "dbname=awesome_db"
   \dt
   select * from messages;

Conclusion

We have looked at the beam library in this post and it’s interaction with postgres. Although the example is simple, there is quite a bit of boilerplate involved, but once setup it provides a complete type safe DSL to the database. With the database and web server in place nothing is stopping the reader from making his next major project in Haskell! We hereby conclude our Haskell safari successfully.

Complete sources

The complete sources can be found on github, and below.

Db.hs

{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE DuplicateRecordFields #-}

-- | db structure and source of truth
module DB where
import qualified Data.ByteString                as BS
import qualified Data.Text                      as Text
import           Database.Beam


data UserT f = User
                { _id :: C f Int
                , _name   :: C f Text.Text
                , _email  :: C f Text.Text
                }
                  deriving Generic
type User = UserT Identity
deriving instance Show UserId
deriving instance Show User

instance Table UserT where
    data PrimaryKey UserT f = UserId (Columnar f Int) deriving Generic
    primaryKey = UserId . (_id :: UserT f -> C f Int)
type UserId = PrimaryKey UserT Identity -- For convenience

instance Beamable UserT
instance Beamable (PrimaryKey UserT)


data MessageT f = Message
                { _id :: C f Int
                , _from      :: PrimaryKey UserT f
                , _content   :: C f Text.Text
                }
                  deriving Generic
type Message = MessageT Identity
deriving instance Show (PrimaryKey MessageT Identity)
deriving instance Show Message

instance Table MessageT where
    data PrimaryKey MessageT f = MessageId (Columnar f Int) deriving Generic
    primaryKey = MessageId . (_id :: MessageT f -> C f Int)
type MessageId = PrimaryKey MessageT Identity -- For convenience

instance Beamable MessageT
instance Beamable (PrimaryKey MessageT)


data AwesomeDb f = AwesomeDb
                      { _ausers    :: f (TableEntity UserT)
                      , _messages :: f (TableEntity MessageT) }
                        deriving Generic

connectionString :: BS.ByteString
connectionString = "dbname=awesome_db"

instance Database be AwesomeDb

awesomeDB :: DatabaseSettings be AwesomeDb
awesomeDB = defaultDbSettings

Lib.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}

module Lib
    ( webAppEntry
    ) where

import Servant
import Control.Monad.IO.Class(liftIO)
import Data.ByteString.Lazy as LBS (writeFile, readFile) 
import Data.Aeson(ToJSON, FromJSON, encode, decode)
import GHC.Generics(Generic)
import Network.Wai(Application)
import Network.Wai.Handler.Warp(run)
import           Database.PostgreSQL.Simple   (Connection)
import qualified DB as DB
import           Database.Beam.Backend.SQL.BeamExtensions (runInsertReturningList)

import qualified Database.Beam                            as Beam
import qualified Database.Beam.Postgres                            as PgBeam
import Data.Text(pack, unpack)

type UserAPI = "users" :> Get '[JSON] [User]
      :<|> "message" :> ReqBody '[JSON] Message :> Post '[JSON] [Message]

data Message = Message {
  from :: User,
  content :: String
} deriving (Eq, Show, Generic)

instance ToJSON Message
instance FromJSON Message

data User = User
  { name :: String
  , email :: String
  } deriving (Eq, Show, Generic)

instance ToJSON User
instance FromJSON User

users :: [User]
users =
  [ User "Isaac Newton"    "isaac@newton.co.uk"
  , User "Albert Einstein" "ae@mc2.org"
  ]

messages :: Connection -> Message -> Handler [Message]
messages conn message = do 
  messages <- liftIO $ 
    PgBeam.runBeamPostgres conn $ do
      let user = from message
      [user] <- runInsertReturningList (DB._ausers DB.awesomeDB) $ 
          Beam.insertExpressions [DB.User 
            Beam.default_
            (Beam.val_ (pack $ name $ user ))
            (Beam.val_ (pack $ email $ user ))
        ]
      _ <- runInsertReturningList (DB._messages DB.awesomeDB) $ 
          Beam.insertExpressions 
            [DB.Message 
              Beam.default_ 
              (Beam.val_ (Beam.pk user))
              (Beam.val_ (pack $ content message))
            ]
      Beam.runSelectReturningList $ Beam.select $ do 
        usr <- (Beam.all_ (DB._ausers DB.awesomeDB))
        msg <- Beam.oneToMany_ (DB._messages DB.awesomeDB) DB._from usr
        pure (msg, usr)
  pure $
    fmap (
      \(msg, usr) -> Message
        (User
          (unpack $ DB._name usr)
          (unpack $ DB._email usr))
        (unpack $ DB._content msg)
    ) messages


server :: Connection -> Server UserAPI
server conn= (pure users) :<|> (messages conn)

userAPI :: Proxy UserAPI
userAPI = Proxy

app :: Connection -> Application
app conn = serve userAPI (server conn)

webAppEntry :: Connection -> IO ()
webAppEntry conn = do
  run 6868 (app conn)

data_model.sql

DROP TABLE ausers cascade;
DROP TABLE messages cascade;
CREATE TABLE ausers (
    id serial NOT NULL PRIMARY KEY,
    "name" varchar NOT NULL,
    email varchar NULL
);

CREATE TABLE messages (
    id serial NOT NULL PRIMARY KEY,
    from__id int REFERENCES ausers(id),
    content varchar NULL
);
haskell programming

Recent stuff

Tags

arubaaustraliabuild-toolscssdatabasedevopsfrphaskellindonesiajakartajoblinuxmysqlnixnixosopinionpainpragmatic-haskellprogrammingprojectrealestatereflexreleaseservantstacktesttimetoolstraveltutorialvirtualizationwebsitewindowswork