Rest api in Haskell

March 05, 2017

Recently I’ve discovered world of functional programming and was really surprised by the amount of fun which it gives back. Not without a reason Haskell is the king of weekend programming:

I want to show you how to build simple rest api with Haskell.

Preparing

You will need:

stack - cross platform program for developing Haskell projects. It manages packages and builds your project
postgresql - open source database system. Install locally or go big and run it on some server.

Execution

run:

1 stack new projectname

to set up all files needed by stack and go to that folder.

Then in projectname.cabal you need to add some libraries. Find executable projectname and add:

1
2
3
4
5
6
7
8
9 executable projectname
    hs-source-dirs: ... #what you want
    main-is: Main.hs
    other-extensions: OverloadedStrings
    build-depends:  base,
                    scotty,
                    aeson,
                    postgresql-simple
    default-language: Haskell2010

then run:

1 stack build

to install all dependencies. Move to folder with Main.sh and let’s start programming!

Haskell time!

Firstly, let’s make super simple api to check if everything is correct:

1
2
3
4
5
6
7
8
9
10
11
12
13 {-# LANGUAGE OverloadedStrings #-}
module Main where

import Web.Scotty

server :: ScottyM ()
server = do
    get "/alive" $ do
        text "yep!"

main :: IO ()
main = do
    scotty 1234 server

and run:

1
2 stack build
stack exec projectname

and now check it in your browser! Write in url: localhost:1234/alive and voilà!

(You can install stack run for less typing when you want to build and execute your program!)

Database setting up

Ok, let’s connect to the database! If you have problem with setting up your Postgresql database I recomend visiting DigitalOcean tutorial

I prepared a simple database input for tutorial purposes. It’s gonna be a simple todo list.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 CREATE TABLE "checklists" (
      "id" SERIAL PRIMARY KEY,
      "title" TEXT
);

insert into checklists (title) values
('backend'),
('shopping');

CREATE TABLE "checklistitems" (
      "id" SERIAL PRIMARY KEY,
      "name" TEXT NOT NULL,
      "finished" BOOLEAN NOT NULL,
      "checklist" INTEGER NOT NULL
);

insert into checklistitems (name, finished, checklist) values
('reformat code', true, 1),
('user login', true, 1),
('add CI', false, 1),
('tomato', false, 2),
('potato', false, 2);

Connect to database

To do this, we need to import PostgreSQL.Simple library

1 import Database.PostgreSQL.Simple

and make a connection:

1 conn <- connectPostgreSQL ("host='127.0.0.1' user='haxor' dbname='haxordb' password='pass'")

Now we should create Checklist and ChecklistItem classes:

1
2
3
4
5
6
7 {-# LANGUAGE DeriveGeneric #-}

...

data Checklist = Checklist { checklistId :: Maybe Int,
    title :: String,
    checklistItems :: [ChecklistItem]} deriving (Show, Generic)

Simple class definition. We use DeriveGeneric for “generic” programming. In next lines of code it will become handy.

1
2
3
4
5 instance FromRow Checklist where
    fromRow = Checklist <$> field <*> field <*> pure []

instance ToRow Checklist where
    toRow c = [toField $ title c]

In case of creating object from SQL query we need to list all fields of our class. Haskell won’t let us create object without setting up all fields. But we cannot get checklist and checklist items in one single query, so we need to pass pure [] as our checklistItems list. When we want to make oposite: include our object into SQL queries - we have full control about which fields we want to pass.

1
2 instance ToJSON Checklist
instance FromJSON Checklist

Here we use {-# LANGUAGE DeriveGeneric #-} language extension. GHC implements this for us.

The same story goes for ChecklistItem

1
2
3
4
5
6
7
8
9
10
11
12
13
14 data ChecklistItem = ChecklistItem { checklistItemId :: Maybe Int,
    itemText :: String,
    finished :: Bool,
    checklist :: Int } deriving (Show, Generic)

instance FromRow ChecklistItem where
    fromRow = ChecklistItem <$> field <*> field <*> field <*> field

instance ToRow ChecklistItem where
    toRow i = [toField $ itemText i, toField $ finished i, toField $ checklist i]

instance ToJSON ChecklistItem

instance FromJSON ChecklistItem

Database queries

Ok, let’s do some queries to our server!

1
2
3
4
5
6
7
8
9
10
11
12 import Control.Monad.IO.Class

server :: Connection -> ScottyM()
server conn = do
    get "/checklists" $ do
        checklists <- liftIO (query_ conn "select id, title from checklists" :: IO [Checklist])
        json checklists

main :: IO ()
main = do
    conn <- connectPostgreSQL ("host='127.0.0.1' user='blog' dbname='blog' password='pass'")
    scotty 1234 $ server conn

It seems working, but we get Checklists without items. How to fix it?

1
2
3
4
5
6
7
8
9
10
11
12 server :: Connection -> ScottyM()
server conn = do
    get "/checklists" $ do
        checklists <- liftIO (query_ conn "select id, title from checklists" :: IO [Checklist])
        checkWithItems <- liftIO (mapM (setArray conn) checklists)
        json checkWithItems

setArray :: Connection -> Checklist -> IO Checklist
setArray conn check = do
    let queryText = "select id, name, finished, checklist from checklistitems where checklist = (?)"
    items <- liftIO (query conn queryText (Only $ checklistId check) :: IO [ChecklistItem])
    return check { checklistItems = items }

Notice that this time we use query instead of query_. query makes “query substitution”: it takes ToRow instance and inserts values in places of ‘?’ inside query string.

Now when we hit localhost:1234/checklists it will return:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44 [
  {
    "checklistItems": [
      {
        "checklist": 1,
        "checklistItemId": 1,
        "finished": true,
        "itemText": "reformat code"
      },
      {
        "checklist": 1,
        "checklistItemId": 2,
        "finished": true,
        "itemText": "user login"
      },
      {
        "checklist": 1,
        "checklistItemId": 3,
        "finished": false,
        "itemText": "add CI"
      }
    ],
    "checklistId": 1,
    "title": "backend"
  },
  {
    "checklistItems": [
      {
        "checklist": 2,
        "checklistItemId": 4,
        "finished": false,
        "itemText": "tomato"
      },
      {
        "checklist": 2,
        "checklistItemId": 5,
        "finished": false,
        "itemText": "potato"
      }
    ],
    "checklistId": 2,
    "title": "shopping"
  }
]

Now let’s implement post method for checklist items:

1
2
3
4
5
6
7
8
9
10
11
12 server conn = do
    ...
    post "/checklistitems" $ do
        item <- jsonData :: ActionM ChecklistItem
        newItem <- liftIO (insertChecklist conn item)
        json newItem

insertChecklist :: Connection -> ChecklistItem -> IO ChecklistItem
insertChecklist conn item = do
    let insertQuery = "insert into checklistitems (name, finished, checklist) values (?, ?, ?) returning id"
    [Only id] <- query conn insertQuery item
    return item { checklistItemId = id }

Now we can create new ChecklistItem and our api returning new object with assigned id.

Sum up

Ok, we’ve made a simple json rest api in Haskell with get and post methods! Here is a full source:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66 {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Main where

import Web.Scotty
import Data.Aeson (FromJSON, ToJSON)
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.ToRow
import Database.PostgreSQL.Simple.FromRow
import Database.PostgreSQL.Simple.ToField
import GHC.Generics
import Control.Monad.IO.Class

server :: Connection -> ScottyM()
server conn = do
    get "/checklists" $ do
        checklists <- liftIO (query_ conn "select id, title from checklists" :: IO [Checklist])
        checkWithItems <- liftIO (mapM (setArray conn) checklists)
        json checkWithItems
    post "/checklistitems" $ do
        item <- jsonData :: ActionM ChecklistItem
        newItem <- liftIO (insertChecklist conn item)
        json newItem

selectChecklistQuery = "select id, name, finished, checklist from checklistitems where checklist = (?)"
insertItemsQuery = "insert into checklistitems (name, finished, checklist) values (?, ?, ?) returning id"

setArray :: Connection -> Checklist -> IO Checklist
setArray conn check = do
    items <- liftIO (query conn selectChecklistQuery (Only $ checklistId check) :: IO [ChecklistItem])
    return check { checklistItems = items }

insertChecklist :: Connection -> ChecklistItem -> IO ChecklistItem
insertChecklist conn item = do
    [Only id] <- query conn insertItemsQuery item
    return item { checklistItemId = id }

main :: IO ()
main = do
    conn <- connectPostgreSQL ("host='127.0.0.1' user='blog' dbname='blog' password='pass'")
    scotty 1234 $ server conn



data Checklist = Checklist { checklistId :: Maybe Int,
    title :: String,
    checklistItems :: [ChecklistItem]} deriving (Show, Generic)

instance FromRow Checklist where
    fromRow = Checklist <$> field <*> field <*> pure []
instance ToRow Checklist where
    toRow c = [toField $ title c]
instance ToJSON Checklist
instance FromJSON Checklist

data ChecklistItem = ChecklistItem { checklistItemId :: Maybe Int,
    itemText :: String,
    finished :: Bool,
    checklist :: Int } deriving (Show, Generic)

instance FromRow ChecklistItem where
    fromRow = ChecklistItem <$> field <*> field <*> field <*> field
instance ToRow ChecklistItem where
    toRow i = [toField $ itemText i, toField $ finished i, toField $ checklist i]
instance ToJSON ChecklistItem
instance FromJSON ChecklistItem

If you have some questions feel free to leave a comment!