Introduction to Web Development with Spock #Haskell

Spock

Spock is a lightweight Haskell web framework inspired by Ruby's Sinatra. It provides a full toolbox including everything to get a quick start into web programming using Haskell.

Spock

Features

Fast routing
JSON
Sessions
Cookies
Database helper
CSRF protection

The Spock package

Hello World!

Spock-0.11.0.0

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Web.Spock
import Web.Spock.Config
import qualified Data.Text as Text

main :: IO ()
main = do
  spockCfg <- defaultSpockCfg () PCNoDatabase ()
  runSpock 8080 $ spock spockCfg $ do

    get root $
      text "Hello Spock!"

    get ("hello" <//> var) $ \name ->
      text (Text.concat ["Hello ", name, "!"])

-- Web.Spock
get root :: ActionCtxT ctx (WebStateM conn sess st) () -> SpockCtxM ctx conn sess st ()

text :: MonadIO m => Text -> ActionCtxT ctx m a

Example: Login API

Form data

To get a form data, Spock provides param function.

post "login" $ do
  maybeUsername <- param "username"
  case maybeUsername of
    Nothing       -> setStatus status400 >> text "Missing parameter."
    Just username -> text (Text.concat ["Username: ", username])

-- Web.Spock
param :: (PathPiece p, MonadIO m) => Text -> ActionCtxT ctx m (Maybe p)

$ curl -XPOST -F'username=lotz' http://localhost:8080/login
Username: lotz

The path-pieces package

First Login API

Preparing the set of username and password.

userList :: [(Text, Text)]
userList =
  [ ("lotz", "password1")
  , ("alice", "password2")
  , ("bob", "password3")
  ]

findCredential :: MonadIO m => ActionCtxT ctx m (Maybe (Text, Text))
findCredential = do
  username <- param "username"
  password <- param "password"
  pure $ (,) <$> username <*> password

Creating post "login".

post "login" $ do
  credential <- findCredential
  case credential of
    Nothing -> setStatus status400 >> text "Missing parameter."
    Just (username, password) ->
      if lookup username userList == Just password
        then text "Login succeed."
        else setStatus status400 >> text "Wrong parameter."

-- Data.List
lookup :: Eq a => a -> [(a, b)] -> Maybe b

$ curl -XPOST -F'username=lotz' -F 'password=password1' http://localhost:8080/login
Login succeed.

Of course, we need to hash password

Using bcrypt library.

-- Crypto.BCrypt
hashPasswordUsingPolicy :: HashingPolicy -> ByteString -> IO (Maybe ByteString)

validatePassword :: ByteString -> ByteString -> Bool

Hashing password in userList.

userList :: [(Text, ByteString)]
userList =
  [ ("lotz", "$2y$04$UMnRYB26AvreBv0v4efdauIIr3qTM0opEKln26tSy6XXmKV4hS56S")
  , ("alice", "$2y$04$kRpVhhxbgerHneJJ4HqmNe8MIB7WbPJPXXI3Zy0hFhWpiaJIz6t3m")
  , ("bob", "$2y$04$qbhEesNseMuIpJfFzN7F7uCN6Y5CB0vmMs7eq708CAAx8wnzxvGAm")
  ]

Create a validation function.

validateCredential :: [(Text, ByteString)] -> (Text, Text) -> Bool
validateCredential userList (username, password) =
  case lookup username userList of
    Nothing -> False
    Just passhash ->
      let password' = Text.encodeUtf8 password
      in  validatePassword passhash password'

Connect to Database

Using mysql-simple library.
Create sample database and table in MySQL.

mysql> USE login_sample;
Database changed

mysql> SHOW TABLES;
+------------------------+
| Tables_in_login_sample |
+------------------------+
| user                   |
+------------------------+
1 row in set (0.00 sec)

mysql> DESC user;
+------------+------------------+------+-----+-------------------+-----------------------------+
| Field      | Type             | Null | Key | Default           | Extra                       |
+------------+------------------+------+-----+-------------------+-----------------------------+
| id         | int(10) unsigned | NO   | PRI | NULL              | auto_increment              |
| username   | varchar(255)     | NO   |     | NULL              |                             |
| password   | varchar(255)     | NO   |     | NULL              |                             |
| created_at | timestamp        | NO   |     | CURRENT_TIMESTAMP |                             |
| updated_at | timestamp        | NO   |     | CURRENT_TIMESTAMP | on update CURRENT_TIMESTAMP |
+------------+------------------+------+-----+-------------------+-----------------------------+
5 rows in set (0.02 sec)

mysql> SELECT * FROM user;
+----+----------+--------------------------------------------------------------+---------------------+---------------------+
| id | username | password                                                     | created_at          | updated_at          |
+----+----------+--------------------------------------------------------------+---------------------+---------------------+
|  1 | lotz     | $2y$04$UMnRYB26AvreBv0v4efdauIIr3qTM0opEKln26tSy6XXmKV4hS56S | 2016-08-28 20:10:52 | 2016-08-28 20:10:52 |
|  2 | alice    | $2y$04$kRpVhhxbgerHneJJ4HqmNe8MIB7WbPJPXXI3Zy0hFhWpiaJIz6t3m | 2016-08-28 20:11:06 | 2016-08-28 20:11:06 |
|  3 | bob      | $2y$04$qbhEesNseMuIpJfFzN7F7uCN6Y5CB0vmMs7eq708CAAx8wnzxvGAm | 2016-08-28 20:11:22 | 2016-08-28 20:11:22 |
+----+----------+--------------------------------------------------------------+---------------------+---------------------+
3 rows in set (0.01 sec)

Preparing database connection.

main :: IO ()
main = do
  let mysqlConnect = MySQL.connect MySQL.defaultConnectInfo {MySQL.connectDatabase = "login_sample"}
      dbConn = ConnBuilder mysqlConnect MySQL.close (PoolCfg 1 1 30)

  spockCfg <- defaultSpockCfg () (PCConn dbConn) ()
  runSpock 8080 $ spock spockCfg $ do

-- Web.Spock
data ConnBuilder a
   = ConnBuilder
   { cb_createConn :: IO a
   , cb_destroyConn :: a -> IO ()
   , cb_poolConfiguration :: PoolCfg
   }

Validation function is changed as below.

validateCredential :: (Text, Text) -> ActionCtxT ctx (WebStateM MySQL.Connection sess st) (Maybe Int)
validateCredential (username, password) = do
  user <- runQuery $ \conn -> do
    results <- MySQL.query conn "SELECT id, password FROM user WHERE username = ?" (MySQL.Only (Text.encodeUtf8 username))
    pure $ (listToMaybe results :: Maybe (Int, ByteString))
  pure $ do
    (userId, passhash) <- user
    guard $ validatePassword passhash (Text.encodeUtf8 password)
    pure userId

-- Data.Maybe
listToMaybe :: [a] -> Maybe a
listToMaybe []    =  Nothing
listToMaybe (a:_) =  Just a

-- Web.Spock
runQuery :: (MySQL.Connection -> IO a) -> ActionCtxT ctx (WebStateM MySQL.Connection sess st) a

Template

Actually, Spock has no template support.
Using stache library for templates.
Preparing templates as below.

views
├── index.mustache
└── login.mustache

views/index.mustache

<p>Hello {{text}}!</p>

views/login.mustache

<form method='POST' action='/login'>
  <legend>username: </legend>
  <input type='text' name='username'/>
  <br/>
  <legend>password: </legend>
  <input type='password' name='password'/>
  <br/>
  <input type='submit'/>
</form>

Let's use templates.

main :: IO ()
main = do

  template <- compileMustacheDir "index" "views/"
  let render pname = TL.toStrict . renderMustache (template {templateActual = pname})

  ...

  spockCfg <- defaultSpockCfg () (PCConn dbConn) ()
  runSpock 8080 $ spock spockCfg $ do

    get root $ html (render "index" (object ["text" .= ("Spock" :: Text)]))

    get "login" $ html (render "login" (object []))

-- Web.Spock
html :: MonadIO m => Text -> ActionCtxT ctx m a

-- Text.Mustache
compileMustacheDir :: (MonadIO m, MonadThrow m) => PName -> FilePath -> m Template

renderMustache :: Template -> Value -> Text

Session

To use session, you just change the type of an argument of defaultSpockCfg.

spockCfg <- defaultSpockCfg (Nothing :: Maybe Int) (PCConn dbConn) ()
runSpock 8080 $ spock spockCfg $ do

  get root $ do
    maybeUserId <- readSession
    case maybeUserId of
      Nothing -> redirect "/login"
      Just userId -> html (render "index" (object ["text" .= (Text.pack (show userId))]))

  get "logout" $ writeSession Nothing >> redirect "/login"

  post "login" $ do
    credential <- findCredential
    case credential of
      Nothing -> redirect "/login"
      Just (username, password) -> do
        maybeUserId <- validateCredential (username, password)
        case maybeUserId of
          Nothing -> redirect "/login"
          Just userId -> writeSession (Just userId) >> redirect "/"

-- Web.Spock
readSession :: ActionCtxT ctx (WebStateM conn sess st) sess

writeSession :: sess -> ActionCtxT ctx (WebStateM conn sess st) ()

modifySession :: (sess -> sess) -> SpockActionCtx ctx conn sess st ()

Logging

Spock create a Middleware in WAI.
WAI is a generic web application interface like WSGI and Rack.

-- Network.Wai
type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived

type Middleware = Application -> Application

-- Web.Spock
spock :: SpockCfg conn sess st -> SpockCtxM () conn sess st -> IO Middleware

You can combine any other Middleware with your Spock app.

Let's use RequestLogger in wai-extra.

spockCfg <- defaultSpockCfg (Nothing:: Maybe Int) (PCConn dbConn) ()
runSpock 8080 $ fmap (logStdoutDev.) $ spock spockCfg $ do
  get root $ do

Thank you

This slide is used at Haskell Day 2016. For this reason it is written in English, but I use a lot of images and code to make it easier to understand .
Final example code is uploaded here.